{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE UndecidableInstances #-}

-- | This module contains just the type of protocol parameters.
module Cardano.Ledger.Babbage.PParams
  ( PParams' (..),
    PParams,
    emptyPParams,
    PParamsUpdate,
    emptyPParamsUpdate,
    updatePParams,
    getLanguageView,
    LangDepView (..),
    encodeLangViews,
    retractPP,
    extendPP,
  )
where

import Cardano.Binary
  ( Encoding,
    FromCBOR (..),
    ToCBOR (..),
  )
import Cardano.Ledger.Alonzo.PParams (LangDepView (..), encodeLangViews, getLanguageView)
import Cardano.Ledger.Alonzo.Scripts
  ( CostModels (..),
    ExUnits (..),
    Prices (..),
  )
import Cardano.Ledger.BaseTypes
  ( NonNegativeInterval,
    Nonce,
    StrictMaybe (..),
    UnitInterval,
    fromSMaybe,
    isSNothing,
  )
import qualified Cardano.Ledger.BaseTypes as BT (ProtVer (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Era (Era)
import Cardano.Ledger.Serialization
  ( FromCBORGroup (..),
    ToCBORGroup (..),
  )
import Cardano.Ledger.Shelley.Orphans ()
import Cardano.Ledger.Shelley.PParams (HKD)
import qualified Cardano.Ledger.Shelley.PParams as Shelley (PParams' (..))
import Cardano.Ledger.Slot (EpochNo (..))
import Control.DeepSeq (NFData)
import Data.Coders
  ( Decode (..),
    Density (..),
    Encode (..),
    Field (..),
    Wrapped (..),
    decode,
    encode,
    field,
    (!>),
    (<!),
  )
import Data.Default (Default (..))
import Data.Functor.Identity (Identity (..))
import GHC.Generics (Generic)
import GHC.Records (HasField (..))
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

type PParamsUpdate era = PParams' StrictMaybe era

-- | Protocol parameters.
-- Alonzo parameters without d and extraEntropy
data PParams' f era = PParams
  { -- | The linear factor for the minimum fee calculation
    PParams' f era -> HKD f Natural
_minfeeA :: !(HKD f Natural),
    -- | The constant factor for the minimum fee calculation
    PParams' f era -> HKD f Natural
_minfeeB :: !(HKD f Natural),
    -- | Maximal block body size
    PParams' f era -> HKD f Natural
_maxBBSize :: !(HKD f Natural),
    -- | Maximal transaction size
    PParams' f era -> HKD f Natural
_maxTxSize :: !(HKD f Natural),
    -- | Maximal block header size
    PParams' f era -> HKD f Natural
_maxBHSize :: !(HKD f Natural),
    -- | The amount of a key registration deposit
    PParams' f era -> HKD f Coin
_keyDeposit :: !(HKD f Coin),
    -- | The amount of a pool registration deposit
    PParams' f era -> HKD f Coin
_poolDeposit :: !(HKD f Coin),
    -- | Maximum number of epochs in the future a pool retirement is allowed to
    -- be scheduled for.
    PParams' f era -> HKD f EpochNo
_eMax :: !(HKD f EpochNo),
    -- | Desired number of pools
    PParams' f era -> HKD f Natural
_nOpt :: !(HKD f Natural),
    -- | Pool influence
    PParams' f era -> HKD f NonNegativeInterval
_a0 :: !(HKD f NonNegativeInterval),
    -- | Monetary expansion
    PParams' f era -> HKD f UnitInterval
_rho :: !(HKD f UnitInterval),
    -- | Treasury expansion
    PParams' f era -> HKD f UnitInterval
_tau :: !(HKD f UnitInterval),
    -- | Protocol version
    PParams' f era -> HKD f ProtVer
_protocolVersion :: !(HKD f BT.ProtVer),
    -- | Minimum Stake Pool Cost
    PParams' f era -> HKD f Coin
_minPoolCost :: !(HKD f Coin),
    -- | Cost in lovelace per byte of UTxO storage (instead of _coinsPerUTxOByte)
    PParams' f era -> HKD f Coin
_coinsPerUTxOByte :: !(HKD f Coin),
    -- | Cost models for non-native script languages
    PParams' f era -> HKD f CostModels
_costmdls :: !(HKD f CostModels),
    -- | Prices of execution units (for non-native script languages)
    PParams' f era -> HKD f Prices
_prices :: !(HKD f Prices),
    -- | Max total script execution resources units allowed per tx
    PParams' f era -> HKD f ExUnits
_maxTxExUnits :: !(HKD f ExUnits),
    -- | Max total script execution resources units allowed per block
    PParams' f era -> HKD f ExUnits
_maxBlockExUnits :: !(HKD f ExUnits),
    -- | Max size of a Value in an output
    PParams' f era -> HKD f Natural
_maxValSize :: !(HKD f Natural),
    -- | Percentage of the txfee which must be provided as collateral when
    -- including non-native scripts.
    PParams' f era -> HKD f Natural
_collateralPercentage :: !(HKD f Natural),
    -- | Maximum number of collateral inputs allowed in a transaction
    PParams' f era -> HKD f Natural
_maxCollateralInputs :: !(HKD f Natural)
  }
  deriving ((forall x. PParams' f era -> Rep (PParams' f era) x)
-> (forall x. Rep (PParams' f era) x -> PParams' f era)
-> Generic (PParams' f era)
forall x. Rep (PParams' f era) x -> PParams' f era
forall x. PParams' f era -> Rep (PParams' f era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall (f :: * -> *) era x.
Rep (PParams' f era) x -> PParams' f era
forall (f :: * -> *) era x.
PParams' f era -> Rep (PParams' f era) x
$cto :: forall (f :: * -> *) era x.
Rep (PParams' f era) x -> PParams' f era
$cfrom :: forall (f :: * -> *) era x.
PParams' f era -> Rep (PParams' f era) x
Generic)

type PParams = PParams' Identity

deriving instance Eq (PParams' Identity era)

deriving instance Show (PParams' Identity era)

deriving instance NFData (PParams' Identity era)

instance NoThunks (PParams era)

instance Era era => ToCBOR (PParams era) where
  toCBOR :: PParams era -> Encoding
toCBOR
    PParams
      { _minfeeA :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA = HKD Identity Natural
minfeeA',
        _minfeeB :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB = HKD Identity Natural
minfeeB',
        _maxBBSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize = HKD Identity Natural
maxBBSize',
        _maxTxSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize = HKD Identity Natural
maxTxSize',
        _maxBHSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize = HKD Identity Natural
maxBHSize',
        _keyDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit = HKD Identity Coin
keyDeposit',
        _poolDeposit :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit = HKD Identity Coin
poolDeposit',
        _eMax :: forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax = HKD Identity EpochNo
eMax',
        _nOpt :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt = HKD Identity Natural
nOpt',
        _a0 :: forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 = HKD Identity NonNegativeInterval
a0',
        _rho :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho = HKD Identity UnitInterval
rho',
        _tau :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau = HKD Identity UnitInterval
tau',
        _protocolVersion :: forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion = HKD Identity ProtVer
protocolVersion',
        _minPoolCost :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost = HKD Identity Coin
minPoolCost',
        _coinsPerUTxOByte :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOByte = HKD Identity Coin
coinsPerUTxOByte',
        _costmdls :: forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls = HKD Identity CostModels
costmdls',
        _prices :: forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices = HKD Identity Prices
prices',
        _maxTxExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits = HKD Identity ExUnits
maxTxExUnits',
        _maxBlockExUnits :: forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits = HKD Identity ExUnits
maxBlockExUnits',
        _maxValSize :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize = HKD Identity Natural
maxValSize',
        _collateralPercentage :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_collateralPercentage = HKD Identity Natural
collateralPercentage',
        _maxCollateralInputs :: forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs = HKD Identity Natural
maxCollateralInputs'
      } =
      Encode ('Closed 'Dense) (PParams' Identity Any) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
        ( (Natural
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Coin
 -> Coin
 -> EpochNo
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> ProtVer
 -> Coin
 -> Coin
 -> CostModels
 -> Prices
 -> ExUnits
 -> ExUnits
 -> Natural
 -> Natural
 -> Natural
 -> PParams' Identity Any)
-> Encode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall t. t -> Encode ('Closed 'Dense) t
Rec (forall era.
HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Coin
-> HKD Identity Coin
-> HKD Identity EpochNo
-> HKD Identity Natural
-> HKD Identity NonNegativeInterval
-> HKD Identity UnitInterval
-> HKD Identity UnitInterval
-> HKD Identity ProtVer
-> HKD Identity Coin
-> HKD Identity Coin
-> HKD Identity CostModels
-> HKD Identity Prices
-> HKD Identity ExUnits
-> HKD Identity ExUnits
-> HKD Identity Natural
-> HKD Identity Natural
-> HKD Identity Natural
-> PParams' Identity era
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
PParams @Identity)
            Encode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
minfeeA'
            Encode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
minfeeB'
            Encode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
maxBBSize'
            Encode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
maxTxSize'
            Encode
  ('Closed 'Dense)
  (Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
maxBHSize'
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
keyDeposit'
            Encode
  ('Closed 'Dense)
  (Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
poolDeposit'
            Encode
  ('Closed 'Dense)
  (EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochNo -> Encode ('Closed 'Dense) EpochNo
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To EpochNo
HKD Identity EpochNo
eMax'
            Encode
  ('Closed 'Dense)
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
nOpt'
            Encode
  ('Closed 'Dense)
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> NonNegativeInterval -> Encode ('Closed 'Dense) NonNegativeInterval
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To NonNegativeInterval
HKD Identity NonNegativeInterval
a0'
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> UnitInterval -> Encode ('Closed 'Dense) UnitInterval
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To UnitInterval
HKD Identity UnitInterval
rho'
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> UnitInterval -> Encode ('Closed 'Dense) UnitInterval
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To UnitInterval
HKD Identity UnitInterval
tau'
            Encode
  ('Closed 'Dense)
  (ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) ProtVer
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> (ProtVer -> Encoding) -> ProtVer -> Encode ('Closed 'Dense) ProtVer
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E ProtVer -> Encoding
forall a. ToCBORGroup a => a -> Encoding
toCBORGroup ProtVer
HKD Identity ProtVer
protocolVersion'
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
minPoolCost'
            Encode
  ('Closed 'Dense)
  (Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Coin -> Encode ('Closed 'Dense) Coin
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
coinsPerUTxOByte'
            Encode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) CostModels
-> Encode
     ('Closed 'Dense)
     (Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CostModels -> Encode ('Closed 'Dense) CostModels
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To CostModels
HKD Identity CostModels
costmdls'
            Encode
  ('Closed 'Dense)
  (Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Prices
-> Encode
     ('Closed 'Dense)
     (ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Prices -> Encode ('Closed 'Dense) Prices
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Prices
HKD Identity Prices
prices'
            Encode
  ('Closed 'Dense)
  (ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) ExUnits
-> Encode
     ('Closed 'Dense)
     (ExUnits -> Natural -> Natural -> Natural -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ExUnits -> Encode ('Closed 'Dense) ExUnits
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
HKD Identity ExUnits
maxTxExUnits'
            Encode
  ('Closed 'Dense)
  (ExUnits -> Natural -> Natural -> Natural -> PParams' Identity Any)
-> Encode ('Closed 'Dense) ExUnits
-> Encode
     ('Closed 'Dense)
     (Natural -> Natural -> Natural -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> ExUnits -> Encode ('Closed 'Dense) ExUnits
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To ExUnits
HKD Identity ExUnits
maxBlockExUnits'
            Encode
  ('Closed 'Dense)
  (Natural -> Natural -> Natural -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense) (Natural -> Natural -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
maxValSize'
            Encode
  ('Closed 'Dense) (Natural -> Natural -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (Natural -> PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
collateralPercentage'
            Encode ('Closed 'Dense) (Natural -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (PParams' Identity Any)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Natural -> Encode ('Closed 'Dense) Natural
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
maxCollateralInputs'
        )

instance Era era => FromCBOR (PParams era) where
  fromCBOR :: Decoder s (PParams era)
fromCBOR =
    Decode ('Closed 'Dense) (PParams era) -> Decoder s (PParams era)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (PParams era) -> Decoder s (PParams era))
-> Decode ('Closed 'Dense) (PParams era) -> Decoder s (PParams era)
forall a b. (a -> b) -> a -> b
$
      (Natural
 -> Natural
 -> Natural
 -> Natural
 -> Natural
 -> Coin
 -> Coin
 -> EpochNo
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> ProtVer
 -> Coin
 -> Coin
 -> CostModels
 -> Prices
 -> ExUnits
 -> ExUnits
 -> Natural
 -> Natural
 -> Natural
 -> PParams era)
-> Decode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall t. t -> Decode ('Closed 'Dense) t
RecD Natural
-> Natural
-> Natural
-> Natural
-> Natural
-> Coin
-> Coin
-> EpochNo
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> ProtVer
-> Coin
-> Coin
-> CostModels
-> Prices
-> ExUnits
-> ExUnits
-> Natural
-> Natural
-> Natural
-> PParams era
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
PParams
        Decode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _minfeeA         :: Integer
        Decode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _minfeeB         :: Natural
        Decode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Natural
      -> Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _maxBBSize       :: Natural
        Decode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Natural
      -> Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _maxTxSize       :: Natural
        Decode
  ('Closed 'Dense)
  (Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _maxBHSize       :: Natural
        Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _keyDeposit      :: Coin
        Decode
  ('Closed 'Dense)
  (Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _poolDeposit     :: Coin
        Decode
  ('Closed 'Dense)
  (EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) EpochNo
-> Decode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _eMax            :: EpochNo
        Decode
  ('Closed 'Dense)
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _nOpt            :: Natural
        Decode
  ('Closed 'Dense)
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) NonNegativeInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) NonNegativeInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _a0              :: NonNegativeInterval
        Decode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _rho             :: UnitInterval
        Decode
  ('Closed 'Dense)
  (UnitInterval
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (ProtVer
      -> Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _tau             :: UnitInterval
        Decode
  ('Closed 'Dense)
  (ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed 'Dense) ProtVer
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! (forall s. Decoder s ProtVer) -> Decode ('Closed 'Dense) ProtVer
forall t. (forall s. Decoder s t) -> Decode ('Closed 'Dense) t
D forall s. Decoder s ProtVer
forall a s. FromCBORGroup a => Decoder s a
fromCBORGroup -- _protocolVersion :: ProtVer
        Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _minPoolCost     :: Natural
        Decode
  ('Closed 'Dense)
  (Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _coinsPerUTxOByte  :: Coin
        Decode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) CostModels
-> Decode
     ('Closed 'Dense)
     (Prices
      -> ExUnits
      -> ExUnits
      -> Natural
      -> Natural
      -> Natural
      -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) CostModels
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _costmdls :: CostModel
        Decode
  ('Closed 'Dense)
  (Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Prices
-> Decode
     ('Closed 'Dense)
     (ExUnits
      -> ExUnits -> Natural -> Natural -> Natural -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Prices
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _prices = prices',
        Decode
  ('Closed 'Dense)
  (ExUnits
   -> ExUnits -> Natural -> Natural -> Natural -> PParams era)
-> Decode ('Closed Any) ExUnits
-> Decode
     ('Closed 'Dense)
     (ExUnits -> Natural -> Natural -> Natural -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _maxTxExUnits = maxTxExUnits',
        Decode
  ('Closed 'Dense)
  (ExUnits -> Natural -> Natural -> Natural -> PParams era)
-> Decode ('Closed Any) ExUnits
-> Decode
     ('Closed 'Dense) (Natural -> Natural -> Natural -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _maxBlockExUnits = maxBlockExUnits'
        Decode
  ('Closed 'Dense) (Natural -> Natural -> Natural -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (Natural -> Natural -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- maxValSize :: Natural
        Decode ('Closed 'Dense) (Natural -> Natural -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (Natural -> PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- collateralPercentage :: Natural
        Decode ('Closed 'Dense) (Natural -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (PParams era)
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- maxCollateralInputs :: Natural

-- | Returns a basic "empty" `PParams` structure with all zero values.
emptyPParams :: PParams era
emptyPParams :: PParams era
emptyPParams =
  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
PParams
    { _minfeeA :: HKD Identity Natural
_minfeeA = HKD Identity Natural
0,
      _minfeeB :: HKD Identity Natural
_minfeeB = HKD Identity Natural
0,
      _maxBBSize :: HKD Identity Natural
_maxBBSize = HKD Identity Natural
0,
      _maxTxSize :: HKD Identity Natural
_maxTxSize = HKD Identity Natural
2048,
      _maxBHSize :: HKD Identity Natural
_maxBHSize = HKD Identity Natural
0,
      _keyDeposit :: HKD Identity Coin
_keyDeposit = Integer -> Coin
Coin Integer
0,
      _poolDeposit :: HKD Identity Coin
_poolDeposit = Integer -> Coin
Coin Integer
0,
      _eMax :: HKD Identity EpochNo
_eMax = Word64 -> EpochNo
EpochNo Word64
0,
      _nOpt :: HKD Identity Natural
_nOpt = HKD Identity Natural
100,
      _a0 :: HKD Identity NonNegativeInterval
_a0 = HKD Identity NonNegativeInterval
forall a. Bounded a => a
minBound,
      _rho :: HKD Identity UnitInterval
_rho = HKD Identity UnitInterval
forall a. Bounded a => a
minBound,
      _tau :: HKD Identity UnitInterval
_tau = HKD Identity UnitInterval
forall a. Bounded a => a
minBound,
      _protocolVersion :: HKD Identity ProtVer
_protocolVersion = Natural -> Natural -> ProtVer
BT.ProtVer Natural
7 Natural
0,
      _minPoolCost :: HKD Identity Coin
_minPoolCost = HKD Identity Coin
forall a. Monoid a => a
mempty,
      _coinsPerUTxOByte :: HKD Identity Coin
_coinsPerUTxOByte = Integer -> Coin
Coin Integer
0,
      _costmdls :: HKD Identity CostModels
_costmdls = Map Language CostModel -> CostModels
CostModels Map Language CostModel
forall a. Monoid a => a
mempty,
      _prices :: HKD Identity Prices
_prices = NonNegativeInterval -> NonNegativeInterval -> Prices
Prices NonNegativeInterval
forall a. Bounded a => a
minBound NonNegativeInterval
forall a. Bounded a => a
minBound,
      _maxTxExUnits :: HKD Identity ExUnits
_maxTxExUnits = Natural -> Natural -> ExUnits
ExUnits Natural
0 Natural
0,
      _maxBlockExUnits :: HKD Identity ExUnits
_maxBlockExUnits = Natural -> Natural -> ExUnits
ExUnits Natural
0 Natural
0,
      _maxValSize :: HKD Identity Natural
_maxValSize = HKD Identity Natural
0,
      _collateralPercentage :: HKD Identity Natural
_collateralPercentage = HKD Identity Natural
150,
      _maxCollateralInputs :: HKD Identity Natural
_maxCollateralInputs = HKD Identity Natural
5
    }

-- | Since ExUnits does not have an Ord instance, we have to roll this Ord instance by hand.
-- IF THE ORDER OR TYPES OF THE FIELDS OF PParams changes, this instance may need adusting.
instance Ord (PParams' StrictMaybe era) where
  compare :: PParams' StrictMaybe era -> PParams' StrictMaybe era -> Ordering
compare PParams' StrictMaybe era
x PParams' StrictMaybe era
y =
    StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Coin -> StrictMaybe Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Coin -> StrictMaybe Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe EpochNo -> StrictMaybe EpochNo -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe NonNegativeInterval
-> StrictMaybe NonNegativeInterval -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe UnitInterval -> StrictMaybe UnitInterval -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe UnitInterval -> StrictMaybe UnitInterval -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe ProtVer -> StrictMaybe ProtVer -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Coin -> StrictMaybe Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Coin -> StrictMaybe Coin -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOByte PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOByte PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe CostModels -> StrictMaybe CostModels -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe CostModels
forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe CostModels
forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Prices -> StrictMaybe Prices -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Prices
forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Prices
forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe ExUnits -> StrictMaybe ExUnits -> Ordering
compareEx (PParams' StrictMaybe era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe ExUnits -> StrictMaybe ExUnits -> Ordering
compareEx (PParams' StrictMaybe era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Natural -> StrictMaybe Natural -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize PParams' StrictMaybe era
y)

compareEx :: StrictMaybe ExUnits -> StrictMaybe ExUnits -> Ordering
compareEx :: StrictMaybe ExUnits -> StrictMaybe ExUnits -> Ordering
compareEx StrictMaybe ExUnits
SNothing StrictMaybe ExUnits
SNothing = Ordering
EQ
compareEx StrictMaybe ExUnits
SNothing (SJust ExUnits
_) = Ordering
LT
compareEx (SJust ExUnits
_) StrictMaybe ExUnits
SNothing = Ordering
GT
compareEx (SJust (ExUnits Natural
m1 Natural
s1)) (SJust (ExUnits Natural
m2 Natural
s2)) = (Natural, Natural) -> (Natural, Natural) -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Natural
m1, Natural
s1) (Natural
m2, Natural
s2)

instance Default (PParams era) where
  def :: PParams era
def = PParams era
forall era. PParams era
emptyPParams

deriving instance Eq (PParams' StrictMaybe era)

deriving instance Show (PParams' StrictMaybe era)

deriving instance NFData (PParams' StrictMaybe era)

instance NoThunks (PParamsUpdate era)

-- =======================================================
-- A PParamsUpdate has StrictMaybe fields, we want to Sparse encode it, by
-- writing only those fields where the field is (SJust x), that is the role of
-- the local function (omitStrictMaybe key x)

encodePParamsUpdate ::
  PParamsUpdate era ->
  Encode ('Closed 'Sparse) (PParamsUpdate era)
encodePParamsUpdate :: PParamsUpdate era -> Encode ('Closed 'Sparse) (PParamsUpdate era)
encodePParamsUpdate PParamsUpdate era
ppup =
  (StrictMaybe Natural
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> StrictMaybe Coin
 -> StrictMaybe Coin
 -> StrictMaybe EpochNo
 -> StrictMaybe Natural
 -> StrictMaybe NonNegativeInterval
 -> StrictMaybe UnitInterval
 -> StrictMaybe UnitInterval
 -> StrictMaybe ProtVer
 -> StrictMaybe Coin
 -> StrictMaybe Coin
 -> StrictMaybe CostModels
 -> StrictMaybe Prices
 -> StrictMaybe ExUnits
 -> StrictMaybe ExUnits
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> StrictMaybe Natural
 -> PParamsUpdate era)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall t. t -> Encode ('Closed 'Sparse) t
Keyed StrictMaybe Natural
-> StrictMaybe Natural
-> StrictMaybe Natural
-> StrictMaybe Natural
-> StrictMaybe Natural
-> StrictMaybe Coin
-> StrictMaybe Coin
-> StrictMaybe EpochNo
-> StrictMaybe Natural
-> StrictMaybe NonNegativeInterval
-> StrictMaybe UnitInterval
-> StrictMaybe UnitInterval
-> StrictMaybe ProtVer
-> StrictMaybe Coin
-> StrictMaybe Coin
-> StrictMaybe CostModels
-> StrictMaybe Prices
-> StrictMaybe ExUnits
-> StrictMaybe ExUnits
-> StrictMaybe Natural
-> StrictMaybe Natural
-> StrictMaybe Natural
-> PParamsUpdate era
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
PParams
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
0 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
1 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
2 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
3 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
4 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Coin
      -> StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Coin
-> (Coin -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
5 (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParamsUpdate era
ppup) Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Coin
   -> StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe EpochNo
      -> StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Coin
-> (Coin -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
6 (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParamsUpdate era
ppup) Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe EpochNo
   -> StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe EpochNo)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe EpochNo
-> (EpochNo -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe EpochNo)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
7 (PParamsUpdate era -> HKD StrictMaybe EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParamsUpdate era
ppup) EpochNo -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe NonNegativeInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
8 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe NonNegativeInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe NonNegativeInterval)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe UnitInterval
      -> StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe NonNegativeInterval
-> (NonNegativeInterval -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe NonNegativeInterval)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
9 (PParamsUpdate era -> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParamsUpdate era
ppup) NonNegativeInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe UnitInterval
   -> StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe UnitInterval)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe UnitInterval
      -> StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe UnitInterval
-> (UnitInterval -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe UnitInterval)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
10 (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParamsUpdate era
ppup) UnitInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe UnitInterval
   -> StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe UnitInterval)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe ProtVer
      -> StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe UnitInterval
-> (UnitInterval -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe UnitInterval)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
11 (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParamsUpdate era
ppup) UnitInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe ProtVer
   -> StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe ProtVer)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Coin
      -> StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe ProtVer
-> (ProtVer -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe ProtVer)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
14 (PParamsUpdate era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParamsUpdate era
ppup) ProtVer -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Coin
   -> StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Coin
      -> StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Coin
-> (Coin -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
16 (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParamsUpdate era
ppup) Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Coin
   -> StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe CostModels
      -> StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Coin
-> (Coin -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Coin)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
17 (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOByte PParamsUpdate era
ppup) Coin -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe CostModels
   -> StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe CostModels)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Prices
      -> StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe CostModels
-> (CostModels -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe CostModels)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
18 (PParamsUpdate era -> HKD StrictMaybe CostModels
forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls PParamsUpdate era
ppup) CostModels -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Prices
   -> StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Prices)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe ExUnits
      -> StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Prices
-> (Prices -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Prices)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
19 (PParamsUpdate era -> HKD StrictMaybe Prices
forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices PParamsUpdate era
ppup) Prices -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe ExUnits
   -> StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe ExUnits)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe ExUnits
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> StrictMaybe Natural
      -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe ExUnits
-> (ExUnits -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe ExUnits)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
20 (PParamsUpdate era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits PParamsUpdate era
ppup) ExUnits -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe ExUnits
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> StrictMaybe Natural
   -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe ExUnits)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural
      -> StrictMaybe Natural -> StrictMaybe Natural -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe ExUnits
-> (ExUnits -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe ExUnits)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
21 (PParamsUpdate era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits PParamsUpdate era
ppup) ExUnits -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural
   -> StrictMaybe Natural -> StrictMaybe Natural -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse)
     (StrictMaybe Natural -> StrictMaybe Natural -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
22 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Natural -> StrictMaybe Natural -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode
     ('Closed 'Sparse) (StrictMaybe Natural -> PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
23 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_collateralPercentage PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode ('Closed 'Sparse) (StrictMaybe Natural -> PParamsUpdate era)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
-> Encode ('Closed 'Sparse) (PParamsUpdate era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word
-> StrictMaybe Natural
-> (Natural -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Natural)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
24 (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs PParamsUpdate era
ppup) Natural -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
  where
    omitStrictMaybe ::
      Word -> StrictMaybe a -> (a -> Encoding) -> Encode ('Closed 'Sparse) (StrictMaybe a)
    omitStrictMaybe :: Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
key StrictMaybe a
x a -> Encoding
enc = (StrictMaybe a -> Bool)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
forall t.
(t -> Bool)
-> Encode ('Closed 'Sparse) t -> Encode ('Closed 'Sparse) t
Omit StrictMaybe a -> Bool
forall a. StrictMaybe a -> Bool
isSNothing (Word
-> Encode ('Closed 'Dense) (StrictMaybe a)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
forall t.
Word -> Encode ('Closed 'Dense) t -> Encode ('Closed 'Sparse) t
Key Word
key ((StrictMaybe a -> Encoding)
-> StrictMaybe a -> Encode ('Closed 'Dense) (StrictMaybe a)
forall t. (t -> Encoding) -> t -> Encode ('Closed 'Dense) t
E (a -> Encoding
enc (a -> Encoding)
-> (StrictMaybe a -> a) -> StrictMaybe a -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe a -> a
forall a. StrictMaybe a -> a
fromSJust) StrictMaybe a
x))

    fromSJust :: StrictMaybe a -> a
    fromSJust :: StrictMaybe a -> a
fromSJust (SJust a
x) = a
x
    fromSJust StrictMaybe a
SNothing = String -> a
forall a. HasCallStack => String -> a
error String
"SNothing in fromSJust. This should never happen, it is guarded by isSNothing."

instance Era era => ToCBOR (PParamsUpdate era) where
  toCBOR :: PParamsUpdate era -> Encoding
toCBOR PParamsUpdate era
ppup = Encode ('Closed 'Sparse) (PParamsUpdate era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (PParamsUpdate era -> Encode ('Closed 'Sparse) (PParamsUpdate era)
forall era.
PParamsUpdate era -> Encode ('Closed 'Sparse) (PParamsUpdate era)
encodePParamsUpdate PParamsUpdate era
ppup)

emptyPParamsUpdate :: PParamsUpdate era
emptyPParamsUpdate :: PParamsUpdate era
emptyPParamsUpdate =
  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
PParams
    { _minfeeA :: HKD StrictMaybe Natural
_minfeeA = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _minfeeB :: HKD StrictMaybe Natural
_minfeeB = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _maxBBSize :: HKD StrictMaybe Natural
_maxBBSize = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _maxTxSize :: HKD StrictMaybe Natural
_maxTxSize = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _maxBHSize :: HKD StrictMaybe Natural
_maxBHSize = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _keyDeposit :: HKD StrictMaybe Coin
_keyDeposit = HKD StrictMaybe Coin
forall a. StrictMaybe a
SNothing,
      _poolDeposit :: HKD StrictMaybe Coin
_poolDeposit = HKD StrictMaybe Coin
forall a. StrictMaybe a
SNothing,
      _eMax :: HKD StrictMaybe EpochNo
_eMax = HKD StrictMaybe EpochNo
forall a. StrictMaybe a
SNothing,
      _nOpt :: HKD StrictMaybe Natural
_nOpt = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _a0 :: HKD StrictMaybe NonNegativeInterval
_a0 = HKD StrictMaybe NonNegativeInterval
forall a. StrictMaybe a
SNothing,
      _rho :: HKD StrictMaybe UnitInterval
_rho = HKD StrictMaybe UnitInterval
forall a. StrictMaybe a
SNothing,
      _tau :: HKD StrictMaybe UnitInterval
_tau = HKD StrictMaybe UnitInterval
forall a. StrictMaybe a
SNothing,
      _protocolVersion :: HKD StrictMaybe ProtVer
_protocolVersion = HKD StrictMaybe ProtVer
forall a. StrictMaybe a
SNothing,
      _minPoolCost :: HKD StrictMaybe Coin
_minPoolCost = HKD StrictMaybe Coin
forall a. StrictMaybe a
SNothing,
      _coinsPerUTxOByte :: HKD StrictMaybe Coin
_coinsPerUTxOByte = HKD StrictMaybe Coin
forall a. StrictMaybe a
SNothing,
      _costmdls :: HKD StrictMaybe CostModels
_costmdls = HKD StrictMaybe CostModels
forall a. StrictMaybe a
SNothing,
      _prices :: HKD StrictMaybe Prices
_prices = HKD StrictMaybe Prices
forall a. StrictMaybe a
SNothing,
      _maxTxExUnits :: HKD StrictMaybe ExUnits
_maxTxExUnits = HKD StrictMaybe ExUnits
forall a. StrictMaybe a
SNothing,
      _maxBlockExUnits :: HKD StrictMaybe ExUnits
_maxBlockExUnits = HKD StrictMaybe ExUnits
forall a. StrictMaybe a
SNothing,
      _maxValSize :: HKD StrictMaybe Natural
_maxValSize = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _collateralPercentage :: HKD StrictMaybe Natural
_collateralPercentage = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing,
      _maxCollateralInputs :: HKD StrictMaybe Natural
_maxCollateralInputs = HKD StrictMaybe Natural
forall a. StrictMaybe a
SNothing
    }

updateField :: Word -> Field (PParamsUpdate era)
updateField :: Word -> Field (PParamsUpdate era)
updateField Word
0 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_minfeeA :: HKD StrictMaybe Natural
_minfeeA = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
1 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_minfeeB :: HKD StrictMaybe Natural
_minfeeB = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
2 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxBBSize :: HKD StrictMaybe Natural
_maxBBSize = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
3 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxTxSize :: HKD StrictMaybe Natural
_maxTxSize = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
4 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxBHSize :: HKD StrictMaybe Natural
_maxBHSize = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
5 = (Coin -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Coin -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x PParamsUpdate era
up -> PParamsUpdate era
up {_keyDeposit :: HKD StrictMaybe Coin
_keyDeposit = Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
6 = (Coin -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Coin -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x PParamsUpdate era
up -> PParamsUpdate era
up {_poolDeposit :: HKD StrictMaybe Coin
_poolDeposit = Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
7 = (EpochNo -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) EpochNo -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\EpochNo
x PParamsUpdate era
up -> PParamsUpdate era
up {_eMax :: HKD StrictMaybe EpochNo
_eMax = EpochNo -> StrictMaybe EpochNo
forall a. a -> StrictMaybe a
SJust EpochNo
x}) Decode ('Closed Any) EpochNo
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
8 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_nOpt :: HKD StrictMaybe Natural
_nOpt = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
9 = (NonNegativeInterval -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) NonNegativeInterval
-> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\NonNegativeInterval
x PParamsUpdate era
up -> PParamsUpdate era
up {_a0 :: HKD StrictMaybe NonNegativeInterval
_a0 = NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. a -> StrictMaybe a
SJust NonNegativeInterval
x}) Decode ('Closed Any) NonNegativeInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
10 = (UnitInterval -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) UnitInterval -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\UnitInterval
x PParamsUpdate era
up -> PParamsUpdate era
up {_rho :: HKD StrictMaybe UnitInterval
_rho = UnitInterval -> StrictMaybe UnitInterval
forall a. a -> StrictMaybe a
SJust UnitInterval
x}) Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
11 = (UnitInterval -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) UnitInterval -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\UnitInterval
x PParamsUpdate era
up -> PParamsUpdate era
up {_tau :: HKD StrictMaybe UnitInterval
_tau = UnitInterval -> StrictMaybe UnitInterval
forall a. a -> StrictMaybe a
SJust UnitInterval
x}) Decode ('Closed Any) UnitInterval
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
14 = (ProtVer -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) ProtVer -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\ProtVer
x PParamsUpdate era
up -> PParamsUpdate era
up {_protocolVersion :: HKD StrictMaybe ProtVer
_protocolVersion = ProtVer -> StrictMaybe ProtVer
forall a. a -> StrictMaybe a
SJust ProtVer
x}) Decode ('Closed Any) ProtVer
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
16 = (Coin -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Coin -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x PParamsUpdate era
up -> PParamsUpdate era
up {_minPoolCost :: HKD StrictMaybe Coin
_minPoolCost = Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
17 = (Coin -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Coin -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Coin
x PParamsUpdate era
up -> PParamsUpdate era
up {_coinsPerUTxOByte :: HKD StrictMaybe Coin
_coinsPerUTxOByte = Coin -> StrictMaybe Coin
forall a. a -> StrictMaybe a
SJust Coin
x}) Decode ('Closed Any) Coin
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
18 = (CostModels -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) CostModels -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\CostModels
x PParamsUpdate era
up -> PParamsUpdate era
up {_costmdls :: HKD StrictMaybe CostModels
_costmdls = CostModels -> StrictMaybe CostModels
forall a. a -> StrictMaybe a
SJust CostModels
x}) Decode ('Closed Any) CostModels
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
19 = (Prices -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Prices -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Prices
x PParamsUpdate era
up -> PParamsUpdate era
up {_prices :: HKD StrictMaybe Prices
_prices = Prices -> StrictMaybe Prices
forall a. a -> StrictMaybe a
SJust Prices
x}) Decode ('Closed Any) Prices
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
20 = (ExUnits -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) ExUnits -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\ExUnits
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxTxExUnits :: HKD StrictMaybe ExUnits
_maxTxExUnits = ExUnits -> StrictMaybe ExUnits
forall a. a -> StrictMaybe a
SJust ExUnits
x}) Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
21 = (ExUnits -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) ExUnits -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\ExUnits
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxBlockExUnits :: HKD StrictMaybe ExUnits
_maxBlockExUnits = ExUnits -> StrictMaybe ExUnits
forall a. a -> StrictMaybe a
SJust ExUnits
x}) Decode ('Closed Any) ExUnits
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
22 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxValSize :: HKD StrictMaybe Natural
_maxValSize = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
23 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_collateralPercentage :: HKD StrictMaybe Natural
_collateralPercentage = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
24 = (Natural -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Natural -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Natural
x PParamsUpdate era
up -> PParamsUpdate era
up {_maxCollateralInputs :: HKD StrictMaybe Natural
_maxCollateralInputs = Natural -> StrictMaybe Natural
forall a. a -> StrictMaybe a
SJust Natural
x}) Decode ('Closed Any) Natural
forall t (w :: Wrapped). FromCBOR t => Decode w t
From
updateField Word
k = (Any -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Any -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Any
_x PParamsUpdate era
up -> PParamsUpdate era
up) (Word -> Decode ('Closed Any) Any
forall (w :: Wrapped) t. Word -> Decode w t
Invalid Word
k)

instance Era era => FromCBOR (PParamsUpdate era) where
  fromCBOR :: Decoder s (PParamsUpdate era)
fromCBOR =
    Decode ('Closed 'Dense) (PParamsUpdate era)
-> Decoder s (PParamsUpdate era)
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode
      (String
-> PParamsUpdate era
-> (Word -> Field (PParamsUpdate era))
-> [(Word, String)]
-> Decode ('Closed 'Dense) (PParamsUpdate era)
forall t.
Typeable t =>
String
-> t
-> (Word -> Field t)
-> [(Word, String)]
-> Decode ('Closed 'Dense) t
SparseKeyed String
"PParamsUpdate" PParamsUpdate era
forall era. PParamsUpdate era
emptyPParamsUpdate Word -> Field (PParamsUpdate era)
forall era. Word -> Field (PParamsUpdate era)
updateField [])

-- =================================================================

-- | Update operation for protocol parameters structure @PParams
updatePParams :: PParams era -> PParamsUpdate era -> PParams era
updatePParams :: PParams era -> PParamsUpdate era -> PParams era
updatePParams PParams era
pp PParamsUpdate era
ppup =
  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
PParams
    { _minfeeA :: HKD Identity Natural
_minfeeA = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeA PParamsUpdate era
ppup),
      _minfeeB :: HKD Identity Natural
_minfeeB = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_minfeeB PParamsUpdate era
ppup),
      _maxBBSize :: HKD Identity Natural
_maxBBSize = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBBSize PParamsUpdate era
ppup),
      _maxTxSize :: HKD Identity Natural
_maxTxSize = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxTxSize PParamsUpdate era
ppup),
      _maxBHSize :: HKD Identity Natural
_maxBHSize = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxBHSize PParamsUpdate era
ppup),
      _keyDeposit :: HKD Identity Coin
_keyDeposit = Coin -> StrictMaybe Coin -> Coin
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_keyDeposit PParamsUpdate era
ppup),
      _poolDeposit :: HKD Identity Coin
_poolDeposit = Coin -> StrictMaybe Coin -> Coin
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_poolDeposit PParamsUpdate era
ppup),
      _eMax :: HKD Identity EpochNo
_eMax = EpochNo -> StrictMaybe EpochNo -> EpochNo
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe EpochNo
forall (f :: * -> *) era. PParams' f era -> HKD f EpochNo
_eMax PParamsUpdate era
ppup),
      _nOpt :: HKD Identity Natural
_nOpt = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_nOpt PParamsUpdate era
ppup),
      _a0 :: HKD Identity NonNegativeInterval
_a0 = NonNegativeInterval
-> StrictMaybe NonNegativeInterval -> NonNegativeInterval
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe NonNegativeInterval
forall (f :: * -> *) era.
PParams' f era -> HKD f NonNegativeInterval
_a0 PParamsUpdate era
ppup),
      _rho :: HKD Identity UnitInterval
_rho = UnitInterval -> StrictMaybe UnitInterval -> UnitInterval
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_rho PParamsUpdate era
ppup),
      _tau :: HKD Identity UnitInterval
_tau = UnitInterval -> StrictMaybe UnitInterval -> UnitInterval
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_tau PParamsUpdate era
ppup),
      _protocolVersion :: HKD Identity ProtVer
_protocolVersion = ProtVer -> StrictMaybe ProtVer -> ProtVer
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe ProtVer
forall (f :: * -> *) era. PParams' f era -> HKD f ProtVer
_protocolVersion PParamsUpdate era
ppup),
      _minPoolCost :: HKD Identity Coin
_minPoolCost = Coin -> StrictMaybe Coin -> Coin
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_minPoolCost PParamsUpdate era
ppup),
      _coinsPerUTxOByte :: HKD Identity Coin
_coinsPerUTxOByte = Coin -> StrictMaybe Coin -> Coin
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOByte PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOByte PParamsUpdate era
ppup),
      _costmdls :: HKD Identity CostModels
_costmdls = CostModels -> StrictMaybe CostModels -> CostModels
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity CostModels
forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe CostModels
forall (f :: * -> *) era. PParams' f era -> HKD f CostModels
_costmdls PParamsUpdate era
ppup),
      _prices :: HKD Identity Prices
_prices = Prices -> StrictMaybe Prices -> Prices
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Prices
forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Prices
forall (f :: * -> *) era. PParams' f era -> HKD f Prices
_prices PParamsUpdate era
ppup),
      _maxTxExUnits :: HKD Identity ExUnits
_maxTxExUnits = ExUnits -> StrictMaybe ExUnits -> ExUnits
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxTxExUnits PParamsUpdate era
ppup),
      _maxBlockExUnits :: HKD Identity ExUnits
_maxBlockExUnits = ExUnits -> StrictMaybe ExUnits -> ExUnits
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe ExUnits
forall (f :: * -> *) era. PParams' f era -> HKD f ExUnits
_maxBlockExUnits PParamsUpdate era
ppup),
      _maxValSize :: HKD Identity Natural
_maxValSize = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxValSize PParamsUpdate era
ppup),
      _collateralPercentage :: HKD Identity Natural
_collateralPercentage = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_collateralPercentage PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_collateralPercentage PParamsUpdate era
ppup),
      _maxCollateralInputs :: HKD Identity Natural
_maxCollateralInputs = Natural -> StrictMaybe Natural -> Natural
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Natural
forall (f :: * -> *) era. PParams' f era -> HKD f Natural
_maxCollateralInputs PParamsUpdate era
ppup)
    }

-- | Turn an PParams' into a Shelley.Params'
retractPP :: HKD f Coin -> HKD f UnitInterval -> HKD f Nonce -> PParams' f era -> Shelley.PParams' f era
retractPP :: HKD f Coin
-> HKD f UnitInterval
-> HKD f Nonce
-> PParams' f era
-> PParams' f era
retractPP
  HKD f Coin
c
  HKD f UnitInterval
d
  HKD f Nonce
eE
  (PParams HKD f Natural
ma HKD f Natural
mb HKD f Natural
mxBB HKD f Natural
mxT HKD f Natural
mxBH HKD f Coin
kd HKD f Coin
pd HKD f EpochNo
emx HKD f Natural
a HKD f NonNegativeInterval
n HKD f UnitInterval
rho HKD f UnitInterval
tau HKD f ProtVer
pv HKD f Coin
mnP HKD f Coin
_ HKD f CostModels
_ HKD f Prices
_ HKD f ExUnits
_ HKD f ExUnits
_ HKD f Natural
_ HKD f Natural
_ HKD f Natural
_) =
    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
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 HKD f Natural
ma HKD f Natural
mb HKD f Natural
mxBB HKD f Natural
mxT HKD f Natural
mxBH HKD f Coin
kd HKD f Coin
pd HKD f EpochNo
emx HKD f Natural
a HKD f NonNegativeInterval
n HKD f UnitInterval
rho HKD f UnitInterval
tau HKD f UnitInterval
d HKD f Nonce
eE HKD f ProtVer
pv HKD f Coin
c HKD f Coin
mnP

-- | Given the missing pieces Turn a Shelley.PParams' into an Params'
extendPP ::
  Shelley.PParams' f era1 ->
  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 era2
extendPP :: PParams' f era1
-> 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 era2
extendPP
  (Shelley.PParams HKD f Natural
ma HKD f Natural
mb HKD f Natural
mxBB HKD f Natural
mxT HKD f Natural
mxBH HKD f Coin
kd HKD f Coin
pd HKD f EpochNo
emx HKD f Natural
a HKD f NonNegativeInterval
n HKD f UnitInterval
rho HKD f UnitInterval
tau HKD f UnitInterval
_d HKD f Nonce
_eE HKD f ProtVer
pv HKD f Coin
_ HKD f Coin
mnP)
  HKD f Coin
ada
  HKD f CostModels
cost
  HKD f Prices
price
  HKD f ExUnits
mxTx
  HKD f ExUnits
mxBl
  HKD f Natural
mxV
  HKD f Natural
col
  HKD f Natural
mxCol =
    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 era2
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
PParams HKD f Natural
ma HKD f Natural
mb HKD f Natural
mxBB HKD f Natural
mxT HKD f Natural
mxBH HKD f Coin
kd HKD f Coin
pd HKD f EpochNo
emx HKD f Natural
a HKD f NonNegativeInterval
n HKD f UnitInterval
rho HKD f UnitInterval
tau HKD f ProtVer
pv HKD f Coin
mnP HKD f Coin
ada HKD f CostModels
cost HKD f Prices
price HKD f ExUnits
mxTx HKD f ExUnits
mxBl HKD f Natural
mxV HKD f Natural
col HKD f Natural
mxCol

-- | Since Babbage removes the '_d' field from PParams, we provide this
-- 'HasField' instance which defaults '_d' to '0' in order to reuse
-- code for the reward calculation.
instance HasField "_d" (PParams era) UnitInterval where
  getField :: PParams era -> UnitInterval
getField PParams era
_ = UnitInterval
forall a. Bounded a => a
minBound