{-# 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.Alonzo.PParams
  ( PParams' (..),
    PParams,
    emptyPParams,
    PParamsUpdate,
    emptyPParamsUpdate,
    updatePParams,
    getLanguageView,
    LangDepView (..),
    encodeLangViews,
    retractPP,
    extendPP,
  )
where

import Cardano.Binary
  ( Encoding,
    FromCBOR (..),
    ToCBOR (..),
    encodeMapLen,
    encodeNull,
    encodePreEncoded,
    serialize',
    serializeEncoding',
  )
import Cardano.Ledger.Alonzo.Language (Language (..))
import Cardano.Ledger.Alonzo.Scripts
  ( CostModel,
    CostModels (..),
    ExUnits (..),
    Prices (..),
    getCostModelParams,
  )
import Cardano.Ledger.BaseTypes
  ( NonNegativeInterval,
    Nonce (NeutralNonce),
    StrictMaybe (..),
    UnitInterval,
    fromSMaybe,
    isSNothing,
  )
import qualified Cardano.Ledger.BaseTypes as BT (ProtVer (..))
import Cardano.Ledger.Coin (Coin (..))
import qualified Cardano.Ledger.Core as Core
import Cardano.Ledger.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.ByteString (ByteString)
import qualified Data.ByteString as BS
import Data.Coders
  ( Decode (..),
    Density (..),
    Encode (..),
    Field (..),
    Wrapped (..),
    decode,
    encode,
    encodeFoldableAsIndefinite,
    field,
    (!>),
    (<!),
  )
import Data.Default (Default (..))
import Data.Function (on)
import Data.Functor.Identity (Identity (..))
import Data.List (sortBy)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set
import GHC.Generics (Generic)
import GHC.Records (HasField (getField))
import NoThunks.Class (NoThunks (..))
import Numeric.Natural (Natural)

type PParamsUpdate era = PParams' StrictMaybe era

-- | Protocol parameters.
-- Shelley parameters + additional ones
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),
    -- | Decentralization parameter. Note that the scale is inverted here - a
    -- value of 0 indicates full decentralisation, where 1 indicates full
    -- federalisation.
    PParams' f era -> HKD f UnitInterval
_d :: !(HKD f UnitInterval),
    -- | Extra entropy
    PParams' f era -> HKD f Nonce
_extraEntropy :: !(HKD f Nonce),
    -- | 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),
    -- new/updated for alonzo

    -- | Cost in lovelace per word (8 bytes) of UTxO storage (instead of _minUTxOValue)
    PParams' f era -> HKD f Coin
_coinsPerUTxOWord :: !(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 era = PParams' Identity era

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',
        _d :: forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d = HKD Identity UnitInterval
d',
        _extraEntropy :: forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy = HKD Identity Nonce
extraEntropy',
        _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',
        -- new/updated for alonzo
        _coinsPerUTxOWord :: forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOWord = HKD Identity Coin
coinsPerUTxOWord',
        _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
 -> UnitInterval
 -> Nonce
 -> 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
      -> UnitInterval
      -> Nonce
      -> 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 UnitInterval
-> HKD Identity Nonce
-> 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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
PParams @Identity)
            Encode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) EpochNo
-> Encode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> Nonce
      -> 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)
  (UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (Nonce
      -> 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
d'
            Encode
  ('Closed 'Dense)
  (Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams' Identity Any)
-> Encode ('Closed 'Dense) Nonce
-> 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
!> Nonce -> Encode ('Closed 'Dense) Nonce
forall t. ToCBOR t => t -> Encode ('Closed 'Dense) t
To Nonce
HKD Identity Nonce
extraEntropy'
            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'
            -- new/updated for alonzo
            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
coinsPerUTxOWord'
            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 HKD Identity CostModels
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 HKD Identity Prices
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 HKD Identity ExUnits
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 HKD Identity ExUnits
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
 -> UnitInterval
 -> Nonce
 -> 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
      -> UnitInterval
      -> Nonce
      -> 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
-> UnitInterval
-> Nonce
-> 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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
PParams
        Decode
  ('Closed 'Dense)
  (Natural
   -> Natural
   -> Natural
   -> Natural
   -> Natural
   -> Coin
   -> Coin
   -> EpochNo
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> 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
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (EpochNo
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) EpochNo
-> Decode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) NonNegativeInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> 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
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> Nonce
      -> 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)
  (UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (Nonce
      -> 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 -- _d               :: UnitInterval
        Decode
  ('Closed 'Dense)
  (Nonce
   -> ProtVer
   -> Coin
   -> Coin
   -> CostModels
   -> Prices
   -> ExUnits
   -> ExUnits
   -> Natural
   -> Natural
   -> Natural
   -> PParams era)
-> Decode ('Closed Any) Nonce
-> 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) Nonce
forall t (w :: Wrapped). FromCBOR t => Decode w t
From -- _extraEntropy    :: Nonce
        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
        -- new/updated for alonzo
        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 -- _coinsPerUTxOWord  :: 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 :: CostModels
        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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
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,
      _d :: HKD Identity UnitInterval
_d = HKD Identity UnitInterval
forall a. Bounded a => a
minBound,
      _extraEntropy :: HKD Identity Nonce
_extraEntropy = Nonce
HKD Identity Nonce
NeutralNonce,
      _protocolVersion :: HKD Identity ProtVer
_protocolVersion = Natural -> Natural -> ProtVer
BT.ProtVer Natural
5 Natural
0,
      _minPoolCost :: HKD Identity Coin
_minPoolCost = HKD Identity Coin
forall a. Monoid a => a
mempty,
      -- new/updated for alonzo
      _coinsPerUTxOWord :: HKD Identity Coin
_coinsPerUTxOWord = 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 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
_d PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParams' StrictMaybe era
y)
      Ordering -> Ordering -> Ordering
forall a. Semigroup a => a -> a -> a
<> StrictMaybe Nonce -> StrictMaybe Nonce -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (PParams' StrictMaybe era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy 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
_coinsPerUTxOWord PParams' StrictMaybe era
x) (PParams' StrictMaybe era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOWord 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 UnitInterval
 -> StrictMaybe Nonce
 -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
-> StrictMaybe Nonce
-> 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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 UnitInterval
      -> StrictMaybe Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 Nonce
      -> 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 UnitInterval
   -> StrictMaybe Nonce
   -> 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 Nonce
      -> 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
12 (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParamsUpdate era
ppup) UnitInterval -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR
    Encode
  ('Closed 'Sparse)
  (StrictMaybe Nonce
   -> 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 Nonce)
-> 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 Nonce
-> (Nonce -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe Nonce)
forall a.
Word
-> StrictMaybe a
-> (a -> Encoding)
-> Encode ('Closed 'Sparse) (StrictMaybe a)
omitStrictMaybe Word
13 (PParamsUpdate era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy PParamsUpdate era
ppup) Nonce -> 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
_coinsPerUTxOWord 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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
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,
      _d :: HKD StrictMaybe UnitInterval
_d = HKD StrictMaybe UnitInterval
forall a. StrictMaybe a
SNothing,
      _extraEntropy :: HKD StrictMaybe Nonce
_extraEntropy = HKD StrictMaybe Nonce
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,
      -- new/updated for alonzo
      _coinsPerUTxOWord :: HKD StrictMaybe Coin
_coinsPerUTxOWord = 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
12 = (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 {_d :: HKD StrictMaybe UnitInterval
_d = 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
13 = (Nonce -> PParamsUpdate era -> PParamsUpdate era)
-> Decode ('Closed Any) Nonce -> Field (PParamsUpdate era)
forall x t (d :: Density).
(x -> t -> t) -> Decode ('Closed d) x -> Field t
field (\Nonce
x PParamsUpdate era
up -> PParamsUpdate era
up {_extraEntropy :: HKD StrictMaybe Nonce
_extraEntropy = Nonce -> StrictMaybe Nonce
forall a. a -> StrictMaybe a
SJust Nonce
x}) Decode ('Closed Any) Nonce
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 {_coinsPerUTxOWord :: HKD StrictMaybe Coin
_coinsPerUTxOWord = 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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
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),
      _d :: HKD Identity UnitInterval
_d = 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
_d PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe UnitInterval
forall (f :: * -> *) era. PParams' f era -> HKD f UnitInterval
_d PParamsUpdate era
ppup),
      _extraEntropy :: HKD Identity Nonce
_extraEntropy = Nonce -> StrictMaybe Nonce -> Nonce
forall a. a -> StrictMaybe a -> a
fromSMaybe (PParams era -> HKD Identity Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Nonce
forall (f :: * -> *) era. PParams' f era -> HKD f Nonce
_extraEntropy 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),
      -- new/updated for alonzo
      _coinsPerUTxOWord :: HKD Identity Coin
_coinsPerUTxOWord = 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
_coinsPerUTxOWord PParams era
pp) (PParamsUpdate era -> HKD StrictMaybe Coin
forall (f :: * -> *) era. PParams' f era -> HKD f Coin
_coinsPerUTxOWord 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)
    }

-- ===================================================
-- Figure 1: "Definitions Used in Protocol Parameters"

-- The LangDepView is a key value pair. The key is the (canonically) encoded
-- language tag and the value is the (canonically) encoded set of relevant
-- protocol parameters
data LangDepView = LangDepView {LangDepView -> ByteString
tag :: ByteString, LangDepView -> ByteString
params :: ByteString}
  deriving (LangDepView -> LangDepView -> Bool
(LangDepView -> LangDepView -> Bool)
-> (LangDepView -> LangDepView -> Bool) -> Eq LangDepView
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LangDepView -> LangDepView -> Bool
$c/= :: LangDepView -> LangDepView -> Bool
== :: LangDepView -> LangDepView -> Bool
$c== :: LangDepView -> LangDepView -> Bool
Eq, Int -> LangDepView -> ShowS
[LangDepView] -> ShowS
LangDepView -> String
(Int -> LangDepView -> ShowS)
-> (LangDepView -> String)
-> ([LangDepView] -> ShowS)
-> Show LangDepView
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LangDepView] -> ShowS
$cshowList :: [LangDepView] -> ShowS
show :: LangDepView -> String
$cshow :: LangDepView -> String
showsPrec :: Int -> LangDepView -> ShowS
$cshowsPrec :: Int -> LangDepView -> ShowS
Show, Eq LangDepView
Eq LangDepView
-> (LangDepView -> LangDepView -> Ordering)
-> (LangDepView -> LangDepView -> Bool)
-> (LangDepView -> LangDepView -> Bool)
-> (LangDepView -> LangDepView -> Bool)
-> (LangDepView -> LangDepView -> Bool)
-> (LangDepView -> LangDepView -> LangDepView)
-> (LangDepView -> LangDepView -> LangDepView)
-> Ord LangDepView
LangDepView -> LangDepView -> Bool
LangDepView -> LangDepView -> Ordering
LangDepView -> LangDepView -> LangDepView
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LangDepView -> LangDepView -> LangDepView
$cmin :: LangDepView -> LangDepView -> LangDepView
max :: LangDepView -> LangDepView -> LangDepView
$cmax :: LangDepView -> LangDepView -> LangDepView
>= :: LangDepView -> LangDepView -> Bool
$c>= :: LangDepView -> LangDepView -> Bool
> :: LangDepView -> LangDepView -> Bool
$c> :: LangDepView -> LangDepView -> Bool
<= :: LangDepView -> LangDepView -> Bool
$c<= :: LangDepView -> LangDepView -> Bool
< :: LangDepView -> LangDepView -> Bool
$c< :: LangDepView -> LangDepView -> Bool
compare :: LangDepView -> LangDepView -> Ordering
$ccompare :: LangDepView -> LangDepView -> Ordering
$cp1Ord :: Eq LangDepView
Ord, (forall x. LangDepView -> Rep LangDepView x)
-> (forall x. Rep LangDepView x -> LangDepView)
-> Generic LangDepView
forall x. Rep LangDepView x -> LangDepView
forall x. LangDepView -> Rep LangDepView x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LangDepView x -> LangDepView
$cfrom :: forall x. LangDepView -> Rep LangDepView x
Generic, Context -> LangDepView -> IO (Maybe ThunkInfo)
Proxy LangDepView -> String
(Context -> LangDepView -> IO (Maybe ThunkInfo))
-> (Context -> LangDepView -> IO (Maybe ThunkInfo))
-> (Proxy LangDepView -> String)
-> NoThunks LangDepView
forall a.
(Context -> a -> IO (Maybe ThunkInfo))
-> (Context -> a -> IO (Maybe ThunkInfo))
-> (Proxy a -> String)
-> NoThunks a
showTypeOf :: Proxy LangDepView -> String
$cshowTypeOf :: Proxy LangDepView -> String
wNoThunks :: Context -> LangDepView -> IO (Maybe ThunkInfo)
$cwNoThunks :: Context -> LangDepView -> IO (Maybe ThunkInfo)
noThunks :: Context -> LangDepView -> IO (Maybe ThunkInfo)
$cnoThunks :: Context -> LangDepView -> IO (Maybe ThunkInfo)
NoThunks)

-- In the Alonzo era, the map of languages to cost models was mistakenly encoded
-- using an indefinite CBOR map (contrary to canonical CBOR, as intended) when
-- computing the script integrity hash.
-- For this reason, PlutusV1 remains with this encoding.
-- Future versions of Plutus, starting with PlutusV2 in the Babbage era, will
-- use the intended definite length encoding.
legacyNonCanonicalCostModelEncoder :: CostModel -> Encoding
legacyNonCanonicalCostModelEncoder :: CostModel -> Encoding
legacyNonCanonicalCostModelEncoder = Map Text Integer -> Encoding
forall a (f :: * -> *). (ToCBOR a, Foldable f) => f a -> Encoding
encodeFoldableAsIndefinite (Map Text Integer -> Encoding)
-> (CostModel -> Map Text Integer) -> CostModel -> Encoding
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CostModel -> Map Text Integer
getCostModelParams

getLanguageView ::
  forall era.
  (HasField "_costmdls" (Core.PParams era) CostModels) =>
  Core.PParams era ->
  Language ->
  LangDepView
getLanguageView :: PParams era -> Language -> LangDepView
getLanguageView PParams era
pp lang :: Language
lang@Language
PlutusV1 =
  ByteString -> ByteString -> LangDepView
LangDepView -- The silly double bagging is to keep compatibility with a past bug
    (ByteString -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' (Language -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' Language
lang))
    ( ByteString -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize'
        ( Encoding -> ByteString
serializeEncoding' (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
            Encoding -> (CostModel -> Encoding) -> Maybe CostModel -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
encodeNull CostModel -> Encoding
legacyNonCanonicalCostModelEncoder (Maybe CostModel -> Encoding) -> Maybe CostModel -> Encoding
forall a b. (a -> b) -> a -> b
$
              Language -> Map Language CostModel -> Maybe CostModel
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
lang (CostModels -> Map Language CostModel
unCostModels (CostModels -> Map Language CostModel)
-> CostModels -> Map Language CostModel
forall a b. (a -> b) -> a -> b
$ PParams era -> CostModels
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_costmdls" PParams era
pp)
        )
    )
getLanguageView PParams era
pp lang :: Language
lang@Language
PlutusV2 =
  ByteString -> ByteString -> LangDepView
LangDepView
    (Language -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize' Language
lang)
    ( Encoding -> ByteString
serializeEncoding' (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$
        Encoding -> (CostModel -> Encoding) -> Maybe CostModel -> Encoding
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Encoding
encodeNull CostModel -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (Maybe CostModel -> Encoding) -> Maybe CostModel -> Encoding
forall a b. (a -> b) -> a -> b
$
          Language -> Map Language CostModel -> Maybe CostModel
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Language
lang (CostModels -> Map Language CostModel
unCostModels (CostModels -> Map Language CostModel)
-> CostModels -> Map Language CostModel
forall a b. (a -> b) -> a -> b
$ PParams era -> CostModels
forall k (x :: k) r a. HasField x r a => r -> a
getField @"_costmdls" PParams era
pp)
    )

encodeLangViews :: Set LangDepView -> Encoding
encodeLangViews :: Set LangDepView -> Encoding
encodeLangViews Set LangDepView
views = Word -> Encoding
encodeMapLen Word
n Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> (LangDepView -> Encoding) -> [LangDepView] -> Encoding
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap LangDepView -> Encoding
encPair [LangDepView]
ascending
  where
    n :: Word
n = Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Set LangDepView -> Int
forall a. Set a -> Int
Set.size Set LangDepView
views) :: Word
    ascending :: [LangDepView]
ascending = (LangDepView -> LangDepView -> Ordering)
-> [LangDepView] -> [LangDepView]
forall a. (a -> a -> Ordering) -> [a] -> [a]
sortBy (ByteString -> ByteString -> Ordering
shortLex (ByteString -> ByteString -> Ordering)
-> (LangDepView -> ByteString)
-> LangDepView
-> LangDepView
-> Ordering
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` LangDepView -> ByteString
tag) ([LangDepView] -> [LangDepView]) -> [LangDepView] -> [LangDepView]
forall a b. (a -> b) -> a -> b
$ Set LangDepView -> [LangDepView]
forall a. Set a -> [a]
Set.toList Set LangDepView
views
    encPair :: LangDepView -> Encoding
encPair (LangDepView ByteString
k ByteString
v) = ByteString -> Encoding
encodePreEncoded ByteString
k Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> ByteString -> Encoding
encodePreEncoded ByteString
v
    shortLex :: ByteString -> ByteString -> Ordering
    shortLex :: ByteString -> ByteString -> Ordering
shortLex ByteString
a ByteString
b
      | ByteString -> Int
BS.length ByteString
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< ByteString -> Int
BS.length ByteString
b = Ordering
LT
      | ByteString -> Int
BS.length ByteString
a Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ByteString
b = Ordering
GT
      | Bool
otherwise = ByteString -> ByteString -> Ordering
forall a. Ord a => a -> a -> Ordering
compare ByteString
a ByteString
b

-- | Turn an PParams' into a Shelley.Params'
retractPP :: HKD f Coin -> PParams' f era2 -> Shelley.PParams' f era1
retractPP :: HKD f Coin -> PParams' f era2 -> PParams' f era1
retractPP
  HKD f Coin
c
  (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
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 era1
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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f 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 UnitInterval
-> HKD f Nonce
-> HKD f ProtVer
-> HKD f Coin
-> HKD f Coin
-> HKD f CostModels
-> HKD f Prices
-> HKD f ExUnits
-> HKD f ExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> PParams' f era
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
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