{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}

-- | Ledger fixed/changed the serialisation of @PParams@ in a
-- backwards-incompatible way in
-- <https://github.com/IntersectMBO/ouroboros-network/pull/4349/>.
--
-- This module contains the legacy serialisation in order to keep compatibility
-- with applications (like cardano-cli or Ogmios) that still use the old
-- serialisation logic. We use the negotiated node-to-client version to detect
-- when the client does not yet support the fixed serialisation.
--
-- This module can be removed once the next HF (Conway) has happened.
module Ouroboros.Consensus.Shelley.Ledger.Query.PParamsLegacyEncoder (
    LegacyPParams (..)
  , decodeLegacyPParams
  , encodeLegacyPParams
  ) where

import           Cardano.Ledger.Allegra
import           Cardano.Ledger.Alonzo
import           Cardano.Ledger.Alonzo.PParams
import           Cardano.Ledger.Babbage
import           Cardano.Ledger.Babbage.PParams
import           Cardano.Ledger.Binary
import           Cardano.Ledger.Binary.Coders
import qualified Cardano.Ledger.Binary.Plain as Plain
import           Cardano.Ledger.Conway
import           Cardano.Ledger.Core
import           Cardano.Ledger.Crypto
import           Cardano.Ledger.Mary
import           Cardano.Ledger.Shelley
import           Data.Functor.Identity

newtype LegacyPParams era = LegacyPParams
  { forall era. LegacyPParams era -> PParams era
unLegacyPParams :: PParams era
  }

encodeLegacyPParams :: ToCBOR (LegacyPParams era) => PParams era -> Plain.Encoding
encodeLegacyPParams :: forall era. ToCBOR (LegacyPParams era) => PParams era -> Encoding
encodeLegacyPParams PParams era
pp = LegacyPParams era -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR (PParams era -> LegacyPParams era
forall era. PParams era -> LegacyPParams era
LegacyPParams PParams era
pp)

decodeLegacyPParams :: FromCBOR (LegacyPParams era) => Plain.Decoder s (PParams era)
decodeLegacyPParams :: forall era s.
FromCBOR (LegacyPParams era) =>
Decoder s (PParams era)
decodeLegacyPParams = LegacyPParams era -> PParams era
forall era. LegacyPParams era -> PParams era
unLegacyPParams (LegacyPParams era -> PParams era)
-> Decoder s (LegacyPParams era) -> Decoder s (PParams era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (LegacyPParams era)
forall s. Decoder s (LegacyPParams era)
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Crypto c => ToCBOR (LegacyPParams (ShelleyEra c)) where
  toCBOR :: LegacyPParams (ShelleyEra c) -> Encoding
toCBOR (LegacyPParams PParams (ShelleyEra c)
pp) = PParams (ShelleyEra c) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams (ShelleyEra c)
pp

instance Crypto c => FromCBOR (LegacyPParams (ShelleyEra c)) where
  fromCBOR :: forall s. Decoder s (LegacyPParams (ShelleyEra c))
fromCBOR = PParams (ShelleyEra c) -> LegacyPParams (ShelleyEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (ShelleyEra c) -> LegacyPParams (ShelleyEra c))
-> Decoder s (PParams (ShelleyEra c))
-> Decoder s (LegacyPParams (ShelleyEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PParams (ShelleyEra c))
forall s. Decoder s (PParams (ShelleyEra c))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Crypto c => ToCBOR (LegacyPParams (MaryEra c)) where
  toCBOR :: LegacyPParams (MaryEra c) -> Encoding
toCBOR (LegacyPParams PParams (MaryEra c)
pp) = PParams (MaryEra c) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams (MaryEra c)
pp

instance Crypto c => FromCBOR (LegacyPParams (MaryEra c)) where
  fromCBOR :: forall s. Decoder s (LegacyPParams (MaryEra c))
fromCBOR = PParams (MaryEra c) -> LegacyPParams (MaryEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (MaryEra c) -> LegacyPParams (MaryEra c))
-> Decoder s (PParams (MaryEra c))
-> Decoder s (LegacyPParams (MaryEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PParams (MaryEra c))
forall s. Decoder s (PParams (MaryEra c))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Crypto c => ToCBOR (LegacyPParams (AllegraEra c)) where
  toCBOR :: LegacyPParams (AllegraEra c) -> Encoding
toCBOR (LegacyPParams PParams (AllegraEra c)
pp) = PParams (AllegraEra c) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams (AllegraEra c)
pp

instance Crypto c => FromCBOR (LegacyPParams (AllegraEra c)) where
  fromCBOR :: forall s. Decoder s (LegacyPParams (AllegraEra c))
fromCBOR = PParams (AllegraEra c) -> LegacyPParams (AllegraEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (AllegraEra c) -> LegacyPParams (AllegraEra c))
-> Decoder s (PParams (AllegraEra c))
-> Decoder s (LegacyPParams (AllegraEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PParams (AllegraEra c))
forall s. Decoder s (PParams (AllegraEra c))
forall a s. FromCBOR a => Decoder s a
fromCBOR

instance Crypto c => ToCBOR (LegacyPParams (AlonzoEra c)) where
  toCBOR :: LegacyPParams (AlonzoEra c) -> Encoding
toCBOR (LegacyPParams (PParams AlonzoPParams{HKD Identity Natural
HKD Identity Word16
HKD Identity Word32
HKD Identity OrdExUnits
HKD Identity CoinPerWord
HKD Identity CostModels
HKD Identity Prices
HKD Identity Coin
HKD Identity EpochInterval
HKD Identity Nonce
HKD Identity UnitInterval
HKD Identity NonNegativeInterval
HKD Identity ProtVer
appMinFeeA :: HKD Identity Coin
appMinFeeB :: HKD Identity Coin
appMaxBBSize :: HKD Identity Word32
appMaxTxSize :: HKD Identity Word32
appMaxBHSize :: HKD Identity Word16
appKeyDeposit :: HKD Identity Coin
appPoolDeposit :: HKD Identity Coin
appEMax :: HKD Identity EpochInterval
appNOpt :: HKD Identity Natural
appA0 :: HKD Identity NonNegativeInterval
appRho :: HKD Identity UnitInterval
appTau :: HKD Identity UnitInterval
appD :: HKD Identity UnitInterval
appExtraEntropy :: HKD Identity Nonce
appProtocolVersion :: HKD Identity ProtVer
appMinPoolCost :: HKD Identity Coin
appCoinsPerUTxOWord :: HKD Identity CoinPerWord
appCostModels :: HKD Identity CostModels
appPrices :: HKD Identity Prices
appMaxTxExUnits :: HKD Identity OrdExUnits
appMaxBlockExUnits :: HKD Identity OrdExUnits
appMaxValSize :: HKD Identity Natural
appCollateralPercentage :: HKD Identity Natural
appMaxCollateralInputs :: HKD Identity Natural
appMinFeeA :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appMinFeeB :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appMaxBBSize :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word32
appMaxTxSize :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word32
appMaxBHSize :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Word16
appKeyDeposit :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appPoolDeposit :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appEMax :: forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f EpochInterval
appNOpt :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appA0 :: forall (f :: * -> *) era.
AlonzoPParams f era -> HKD f NonNegativeInterval
appRho :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appTau :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appD :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f UnitInterval
appExtraEntropy :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Nonce
appProtocolVersion :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f ProtVer
appMinPoolCost :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Coin
appCoinsPerUTxOWord :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f CoinPerWord
appCostModels :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f CostModels
appPrices :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Prices
appMaxTxExUnits :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f OrdExUnits
appMaxBlockExUnits :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f OrdExUnits
appMaxValSize :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appCollateralPercentage :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
appMaxCollateralInputs :: forall (f :: * -> *) era. AlonzoPParams f era -> HKD f Natural
..})) =
    Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
eraProtVerLow @(AlonzoEra c)) (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$
      Encode ('Closed 'Dense) (LegacyPParams (AlonzoEra c)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
        ( (Coin
 -> Coin
 -> Word32
 -> Word32
 -> Word16
 -> Coin
 -> Coin
 -> EpochInterval
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> Nonce
 -> ProtVer
 -> Coin
 -> CoinPerWord
 -> CostModels
 -> Prices
 -> OrdExUnits
 -> OrdExUnits
 -> Natural
 -> Natural
 -> Natural
 -> LegacyPParams (AlonzoEra c))
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> Coin
-> CoinPerWord
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (AlonzoEra c)
mkLegacyAlonzoPParams
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
appMinFeeA
            Encode
  ('Closed 'Dense)
  (Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
appMinFeeB
            Encode
  ('Closed 'Dense)
  (Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Word32
-> Encode
     ('Closed 'Dense)
     (Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word32 -> Encode ('Closed 'Dense) Word32
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word32
HKD Identity Word32
appMaxBBSize
            Encode
  ('Closed 'Dense)
  (Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Word32
-> Encode
     ('Closed 'Dense)
     (Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word32 -> Encode ('Closed 'Dense) Word32
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word32
HKD Identity Word32
appMaxTxSize
            Encode
  ('Closed 'Dense)
  (Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Word16
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word16 -> Encode ('Closed 'Dense) Word16
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word16
HKD Identity Word16
appMaxBHSize
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
appKeyDeposit
            Encode
  ('Closed 'Dense)
  (Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
appPoolDeposit
            Encode
  ('Closed 'Dense)
  (EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) EpochInterval
-> Encode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochInterval -> Encode ('Closed 'Dense) EpochInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochInterval
HKD Identity EpochInterval
appEMax
            Encode
  ('Closed 'Dense)
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
appNOpt
            Encode
  ('Closed 'Dense)
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity NonNegativeInterval
NonNegativeInterval
appA0
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity UnitInterval
UnitInterval
appRho
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity UnitInterval
UnitInterval
appTau
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity UnitInterval
UnitInterval
appD
            Encode
  ('Closed 'Dense)
  (Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Nonce
-> Encode
     ('Closed 'Dense)
     (ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity Nonce
Nonce
appExtraEntropy
            Encode
  ('Closed 'Dense)
  (ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) ProtVer
-> Encode
     ('Closed 'Dense)
     (Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBORGroup a => a -> Encoding
encCBORGroup HKD Identity ProtVer
ProtVer
appProtocolVersion
            Encode
  ('Closed 'Dense)
  (Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
appMinPoolCost
            -- new/updated for alonzo
            Encode
  ('Closed 'Dense)
  (CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) CoinPerWord
-> Encode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CoinPerWord -> Encode ('Closed 'Dense) CoinPerWord
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CoinPerWord
HKD Identity CoinPerWord
appCoinsPerUTxOWord
            Encode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) CostModels
-> Encode
     ('Closed 'Dense)
     (Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CostModels
HKD Identity CostModels
appCostModels
            Encode
  ('Closed 'Dense)
  (Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Prices
-> Encode
     ('Closed 'Dense)
     (OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Prices
HKD Identity Prices
appPrices
            Encode
  ('Closed 'Dense)
  (OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) OrdExUnits
-> Encode
     ('Closed 'Dense)
     (OrdExUnits
      -> Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> OrdExUnits -> Encode ('Closed 'Dense) OrdExUnits
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OrdExUnits
HKD Identity OrdExUnits
appMaxTxExUnits
            Encode
  ('Closed 'Dense)
  (OrdExUnits
   -> Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) OrdExUnits
-> Encode
     ('Closed 'Dense)
     (Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> OrdExUnits -> Encode ('Closed 'Dense) OrdExUnits
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OrdExUnits
HKD Identity OrdExUnits
appMaxBlockExUnits
            Encode
  ('Closed 'Dense)
  (Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Natural -> Natural -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
appMaxValSize
            Encode
  ('Closed 'Dense)
  (Natural -> Natural -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (Natural -> LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
appCollateralPercentage
            Encode ('Closed 'Dense) (Natural -> LegacyPParams (AlonzoEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (LegacyPParams (AlonzoEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
appMaxCollateralInputs
        )
    where
      mkLegacyAlonzoPParams :: Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> Coin
-> CoinPerWord
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (AlonzoEra c)
mkLegacyAlonzoPParams Coin
a Coin
b Word32
c Word32
d Word16
e Coin
f Coin
g EpochInterval
h Natural
i NonNegativeInterval
j UnitInterval
k UnitInterval
l UnitInterval
m Nonce
n ProtVer
o Coin
p CoinPerWord
q CostModels
r Prices
s OrdExUnits
t OrdExUnits
u Natural
v Natural
w Natural
x =
        PParams (AlonzoEra c) -> LegacyPParams (AlonzoEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (AlonzoEra c) -> LegacyPParams (AlonzoEra c))
-> PParams (AlonzoEra c) -> LegacyPParams (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$
          PParamsHKD Identity (AlonzoEra c) -> PParams (AlonzoEra c)
forall era. PParamsHKD Identity era -> PParams era
PParams (PParamsHKD Identity (AlonzoEra c) -> PParams (AlonzoEra c))
-> PParamsHKD Identity (AlonzoEra c) -> PParams (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochInterval
-> 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 CoinPerWord
-> HKD f CostModels
-> HKD f Prices
-> HKD f OrdExUnits
-> HKD f OrdExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> AlonzoPParams f era
AlonzoPParams @Identity @(AlonzoEra c) Coin
HKD Identity Coin
a Coin
HKD Identity Coin
b Word32
HKD Identity Word32
c Word32
HKD Identity Word32
d Word16
HKD Identity Word16
e Coin
HKD Identity Coin
f Coin
HKD Identity Coin
g EpochInterval
HKD Identity EpochInterval
h Natural
HKD Identity Natural
i HKD Identity NonNegativeInterval
NonNegativeInterval
j HKD Identity UnitInterval
UnitInterval
k HKD Identity UnitInterval
UnitInterval
l HKD Identity UnitInterval
UnitInterval
m HKD Identity Nonce
Nonce
n HKD Identity ProtVer
ProtVer
o Coin
HKD Identity Coin
p CoinPerWord
HKD Identity CoinPerWord
q CostModels
HKD Identity CostModels
r Prices
HKD Identity Prices
s OrdExUnits
HKD Identity OrdExUnits
t OrdExUnits
HKD Identity OrdExUnits
u Natural
HKD Identity Natural
v Natural
HKD Identity Natural
w Natural
HKD Identity Natural
x

instance Crypto c => FromCBOR (LegacyPParams (AlonzoEra c)) where
  fromCBOR :: forall s. Decoder s (LegacyPParams (AlonzoEra c))
fromCBOR =
    Version
-> Decoder s (LegacyPParams (AlonzoEra c))
-> Decoder s (LegacyPParams (AlonzoEra c))
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder (forall era. Era era => Version
eraProtVerLow @(AlonzoEra c)) (Decoder s (LegacyPParams (AlonzoEra c))
 -> Decoder s (LegacyPParams (AlonzoEra c)))
-> Decoder s (LegacyPParams (AlonzoEra c))
-> Decoder s (LegacyPParams (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$
      Decode ('Closed 'Dense) (LegacyPParams (AlonzoEra c))
-> Decoder s (LegacyPParams (AlonzoEra c))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (LegacyPParams (AlonzoEra c))
 -> Decoder s (LegacyPParams (AlonzoEra c)))
-> Decode ('Closed 'Dense) (LegacyPParams (AlonzoEra c))
-> Decoder s (LegacyPParams (AlonzoEra c))
forall a b. (a -> b) -> a -> b
$
        (Coin
 -> Coin
 -> Word32
 -> Word32
 -> Word16
 -> Coin
 -> Coin
 -> EpochInterval
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> UnitInterval
 -> Nonce
 -> ProtVer
 -> Coin
 -> CoinPerWord
 -> CostModels
 -> Prices
 -> OrdExUnits
 -> OrdExUnits
 -> Natural
 -> Natural
 -> Natural
 -> LegacyPParams (AlonzoEra c))
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> Coin
-> CoinPerWord
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (AlonzoEra c)
mkLegacyAlonzoPParams
          Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appMinFeeA
          Decode
  ('Closed 'Dense)
  (Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appMinFeeB
          Decode
  ('Closed 'Dense)
  (Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Word32
-> Decode
     ('Closed 'Dense)
     (Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word32
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appMaxBBSize
          Decode
  ('Closed 'Dense)
  (Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Word32
-> Decode
     ('Closed 'Dense)
     (Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word32
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appMaxTxSize
          Decode
  ('Closed 'Dense)
  (Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Word16
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word16
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appMaxBHSize
          Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appKeyDeposit
          Decode
  ('Closed 'Dense)
  (Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appPoolDeposit
          Decode
  ('Closed 'Dense)
  (EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) EpochInterval
-> Decode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appEMax
          Decode
  ('Closed 'Dense)
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appNOpt
          Decode
  ('Closed 'Dense)
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) NonNegativeInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appA0
          Decode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appRho
          Decode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appTau
          Decode
  ('Closed 'Dense)
  (UnitInterval
   -> Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (Nonce
      -> ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appD
          Decode
  ('Closed 'Dense)
  (Nonce
   -> ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Nonce
-> Decode
     ('Closed 'Dense)
     (ProtVer
      -> Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appExtraEntropy
          Decode
  ('Closed 'Dense)
  (ProtVer
   -> Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed 'Dense) ProtVer
-> Decode
     ('Closed 'Dense)
     (Coin
      -> CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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 Decoder s ProtVer
forall s. Decoder s ProtVer
forall a s. DecCBORGroup a => Decoder s a
decCBORGroup -- appProtocolVersion
          Decode
  ('Closed 'Dense)
  (Coin
   -> CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (CoinPerWord
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appMinPoolCost
          -- new/updated for alonzo
          Decode
  ('Closed 'Dense)
  (CoinPerWord
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) CoinPerWord
-> Decode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) CoinPerWord
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appCoinsPerUTxOWord
          Decode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) CostModels
-> Decode
     ('Closed 'Dense)
     (Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appCostModels
          Decode
  ('Closed 'Dense)
  (Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Prices
-> Decode
     ('Closed 'Dense)
     (OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appPrices
          Decode
  ('Closed 'Dense)
  (OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) OrdExUnits
-> Decode
     ('Closed 'Dense)
     (OrdExUnits
      -> Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) OrdExUnits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appMaxTxExUnits
          Decode
  ('Closed 'Dense)
  (OrdExUnits
   -> Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) OrdExUnits
-> Decode
     ('Closed 'Dense)
     (Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) OrdExUnits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- appMaxBlockExUnits
          Decode
  ('Closed 'Dense)
  (Natural -> Natural -> Natural -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Natural -> Natural -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appMaxValSize
          Decode
  ('Closed 'Dense)
  (Natural -> Natural -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (Natural -> LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appCollateralPercentage
          Decode ('Closed 'Dense) (Natural -> LegacyPParams (AlonzoEra c))
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (LegacyPParams (AlonzoEra c))
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). DecCBOR t => Decode w t
From -- appMaxCollateralInputs
    where
      mkLegacyAlonzoPParams :: Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> Nonce
-> ProtVer
-> Coin
-> CoinPerWord
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (AlonzoEra c)
mkLegacyAlonzoPParams Coin
a Coin
b Word32
c Word32
d Word16
e Coin
f Coin
g EpochInterval
h Natural
i NonNegativeInterval
j UnitInterval
k UnitInterval
l UnitInterval
m Nonce
n ProtVer
o Coin
p CoinPerWord
q CostModels
r Prices
s OrdExUnits
t OrdExUnits
u Natural
v Natural
w Natural
x =
        PParams (AlonzoEra c) -> LegacyPParams (AlonzoEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (AlonzoEra c) -> LegacyPParams (AlonzoEra c))
-> PParams (AlonzoEra c) -> LegacyPParams (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$
          PParamsHKD Identity (AlonzoEra c) -> PParams (AlonzoEra c)
forall era. PParamsHKD Identity era -> PParams era
PParams (PParamsHKD Identity (AlonzoEra c) -> PParams (AlonzoEra c))
-> PParamsHKD Identity (AlonzoEra c) -> PParams (AlonzoEra c)
forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochInterval
-> 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 CoinPerWord
-> HKD f CostModels
-> HKD f Prices
-> HKD f OrdExUnits
-> HKD f OrdExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> AlonzoPParams f era
AlonzoPParams @Identity @(AlonzoEra c) Coin
HKD Identity Coin
a Coin
HKD Identity Coin
b Word32
HKD Identity Word32
c Word32
HKD Identity Word32
d Word16
HKD Identity Word16
e Coin
HKD Identity Coin
f Coin
HKD Identity Coin
g EpochInterval
HKD Identity EpochInterval
h Natural
HKD Identity Natural
i HKD Identity NonNegativeInterval
NonNegativeInterval
j HKD Identity UnitInterval
UnitInterval
k HKD Identity UnitInterval
UnitInterval
l HKD Identity UnitInterval
UnitInterval
m HKD Identity Nonce
Nonce
n HKD Identity ProtVer
ProtVer
o Coin
HKD Identity Coin
p CoinPerWord
HKD Identity CoinPerWord
q CostModels
HKD Identity CostModels
r Prices
HKD Identity Prices
s OrdExUnits
HKD Identity OrdExUnits
t OrdExUnits
HKD Identity OrdExUnits
u Natural
HKD Identity Natural
v Natural
HKD Identity Natural
w Natural
HKD Identity Natural
x

instance Crypto c => ToCBOR (LegacyPParams (BabbageEra c)) where
  toCBOR :: LegacyPParams (BabbageEra c) -> Encoding
toCBOR (LegacyPParams (PParams BabbagePParams{HKD Identity Natural
HKD Identity Word16
HKD Identity Word32
HKD Identity OrdExUnits
HKD Identity CostModels
HKD Identity Prices
HKD Identity CoinPerByte
HKD Identity Coin
HKD Identity EpochInterval
HKD Identity UnitInterval
HKD Identity NonNegativeInterval
HKD Identity ProtVer
bppMinFeeA :: HKD Identity Coin
bppMinFeeB :: HKD Identity Coin
bppMaxBBSize :: HKD Identity Word32
bppMaxTxSize :: HKD Identity Word32
bppMaxBHSize :: HKD Identity Word16
bppKeyDeposit :: HKD Identity Coin
bppPoolDeposit :: HKD Identity Coin
bppEMax :: HKD Identity EpochInterval
bppNOpt :: HKD Identity Natural
bppA0 :: HKD Identity NonNegativeInterval
bppRho :: HKD Identity UnitInterval
bppTau :: HKD Identity UnitInterval
bppProtocolVersion :: HKD Identity ProtVer
bppMinPoolCost :: HKD Identity Coin
bppCoinsPerUTxOByte :: HKD Identity CoinPerByte
bppCostModels :: HKD Identity CostModels
bppPrices :: HKD Identity Prices
bppMaxTxExUnits :: HKD Identity OrdExUnits
bppMaxBlockExUnits :: HKD Identity OrdExUnits
bppMaxValSize :: HKD Identity Natural
bppCollateralPercentage :: HKD Identity Natural
bppMaxCollateralInputs :: HKD Identity Natural
bppMinFeeA :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppMinFeeB :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppMaxBBSize :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word32
bppMaxTxSize :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word32
bppMaxBHSize :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Word16
bppKeyDeposit :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppPoolDeposit :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppEMax :: forall (f :: * -> *) era.
BabbagePParams f era -> HKD f EpochInterval
bppNOpt :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppA0 :: forall (f :: * -> *) era.
BabbagePParams f era -> HKD f NonNegativeInterval
bppRho :: forall (f :: * -> *) era.
BabbagePParams f era -> HKD f UnitInterval
bppTau :: forall (f :: * -> *) era.
BabbagePParams f era -> HKD f UnitInterval
bppProtocolVersion :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f ProtVer
bppMinPoolCost :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Coin
bppCoinsPerUTxOByte :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f CoinPerByte
bppCostModels :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f CostModels
bppPrices :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Prices
bppMaxTxExUnits :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f OrdExUnits
bppMaxBlockExUnits :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f OrdExUnits
bppMaxValSize :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppCollateralPercentage :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
bppMaxCollateralInputs :: forall (f :: * -> *) era. BabbagePParams f era -> HKD f Natural
..})) =
    Version -> Encoding -> Encoding
toPlainEncoding (forall era. Era era => Version
eraProtVerLow @(BabbageEra c)) (Encoding -> Encoding) -> Encoding -> Encoding
forall a b. (a -> b) -> a -> b
$
      Encode ('Closed 'Dense) (LegacyPParams (BabbageEra c)) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode
        ( (Coin
 -> Coin
 -> Word32
 -> Word32
 -> Word16
 -> Coin
 -> Coin
 -> EpochInterval
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> ProtVer
 -> Coin
 -> CoinPerByte
 -> CostModels
 -> Prices
 -> OrdExUnits
 -> OrdExUnits
 -> Natural
 -> Natural
 -> Natural
 -> LegacyPParams (BabbageEra c))
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall t. t -> Encode ('Closed 'Dense) t
Rec Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> ProtVer
-> Coin
-> CoinPerByte
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (BabbageEra c)
mkLegacyBabbagePParams
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
bppMinFeeA
            Encode
  ('Closed 'Dense)
  (Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
bppMinFeeB
            Encode
  ('Closed 'Dense)
  (Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Word32
-> Encode
     ('Closed 'Dense)
     (Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word32 -> Encode ('Closed 'Dense) Word32
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word32
HKD Identity Word32
bppMaxBBSize
            Encode
  ('Closed 'Dense)
  (Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Word32
-> Encode
     ('Closed 'Dense)
     (Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word32 -> Encode ('Closed 'Dense) Word32
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word32
HKD Identity Word32
bppMaxTxSize
            Encode
  ('Closed 'Dense)
  (Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Word16
-> Encode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> Word16 -> Encode ('Closed 'Dense) Word16
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Word16
HKD Identity Word16
bppMaxBHSize
            Encode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
bppKeyDeposit
            Encode
  ('Closed 'Dense)
  (Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
bppPoolDeposit
            Encode
  ('Closed 'Dense)
  (EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) EpochInterval
-> Encode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> EpochInterval -> Encode ('Closed 'Dense) EpochInterval
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To EpochInterval
HKD Identity EpochInterval
bppEMax
            Encode
  ('Closed 'Dense)
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
bppNOpt
            Encode
  ('Closed 'Dense)
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) NonNegativeInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity NonNegativeInterval
NonNegativeInterval
bppA0
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity UnitInterval
UnitInterval
bppRho
            Encode
  ('Closed 'Dense)
  (UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) UnitInterval
-> Encode
     ('Closed 'Dense)
     (ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To HKD Identity UnitInterval
UnitInterval
bppTau
            Encode
  ('Closed 'Dense)
  (ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) ProtVer
-> Encode
     ('Closed 'Dense)
     (Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBORGroup a => a -> Encoding
encCBORGroup HKD Identity ProtVer
ProtVer
bppProtocolVersion
            Encode
  ('Closed 'Dense)
  (Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Coin
-> Encode
     ('Closed 'Dense)
     (CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Coin
HKD Identity Coin
bppMinPoolCost
            Encode
  ('Closed 'Dense)
  (CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) CoinPerByte
-> Encode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> CoinPerByte -> Encode ('Closed 'Dense) CoinPerByte
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CoinPerByte
HKD Identity CoinPerByte
bppCoinsPerUTxOByte
            Encode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) CostModels
-> Encode
     ('Closed 'Dense)
     (Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To CostModels
HKD Identity CostModels
bppCostModels
            Encode
  ('Closed 'Dense)
  (Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Prices
-> Encode
     ('Closed 'Dense)
     (OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Prices
HKD Identity Prices
bppPrices
            Encode
  ('Closed 'Dense)
  (OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) OrdExUnits
-> Encode
     ('Closed 'Dense)
     (OrdExUnits
      -> Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> OrdExUnits -> Encode ('Closed 'Dense) OrdExUnits
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OrdExUnits
HKD Identity OrdExUnits
bppMaxTxExUnits
            Encode
  ('Closed 'Dense)
  (OrdExUnits
   -> Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) OrdExUnits
-> Encode
     ('Closed 'Dense)
     (Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode ('Closed r) a -> Encode w t
!> OrdExUnits -> Encode ('Closed 'Dense) OrdExUnits
forall t. EncCBOR t => t -> Encode ('Closed 'Dense) t
To OrdExUnits
HKD Identity OrdExUnits
bppMaxBlockExUnits
            Encode
  ('Closed 'Dense)
  (Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense)
     (Natural -> Natural -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
bppMaxValSize
            Encode
  ('Closed 'Dense)
  (Natural -> Natural -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode
     ('Closed 'Dense) (Natural -> LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
bppCollateralPercentage
            Encode ('Closed 'Dense) (Natural -> LegacyPParams (BabbageEra c))
-> Encode ('Closed 'Dense) Natural
-> Encode ('Closed 'Dense) (LegacyPParams (BabbageEra c))
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. EncCBOR t => t -> Encode ('Closed 'Dense) t
To Natural
HKD Identity Natural
bppMaxCollateralInputs
        )
    where
      mkLegacyBabbagePParams :: Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> ProtVer
-> Coin
-> CoinPerByte
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (BabbageEra c)
mkLegacyBabbagePParams Coin
a Coin
b Word32
c Word32
d Word16
e Coin
f Coin
g EpochInterval
h Natural
i NonNegativeInterval
j UnitInterval
k UnitInterval
l ProtVer
m Coin
n CoinPerByte
o CostModels
p Prices
q OrdExUnits
r OrdExUnits
s Natural
t Natural
u Natural
v =
        PParams (BabbageEra c) -> LegacyPParams (BabbageEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (BabbageEra c) -> LegacyPParams (BabbageEra c))
-> PParams (BabbageEra c) -> LegacyPParams (BabbageEra c)
forall a b. (a -> b) -> a -> b
$
          PParamsHKD Identity (BabbageEra c) -> PParams (BabbageEra c)
forall era. PParamsHKD Identity era -> PParams era
PParams (PParamsHKD Identity (BabbageEra c) -> PParams (BabbageEra c))
-> PParamsHKD Identity (BabbageEra c) -> PParams (BabbageEra c)
forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochInterval
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> HKD f CoinPerByte
-> HKD f CostModels
-> HKD f Prices
-> HKD f OrdExUnits
-> HKD f OrdExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> BabbagePParams f era
BabbagePParams @Identity @(BabbageEra c) Coin
HKD Identity Coin
a Coin
HKD Identity Coin
b Word32
HKD Identity Word32
c Word32
HKD Identity Word32
d Word16
HKD Identity Word16
e Coin
HKD Identity Coin
f Coin
HKD Identity Coin
g EpochInterval
HKD Identity EpochInterval
h Natural
HKD Identity Natural
i HKD Identity NonNegativeInterval
NonNegativeInterval
j HKD Identity UnitInterval
UnitInterval
k HKD Identity UnitInterval
UnitInterval
l HKD Identity ProtVer
ProtVer
m Coin
HKD Identity Coin
n CoinPerByte
HKD Identity CoinPerByte
o CostModels
HKD Identity CostModels
p Prices
HKD Identity Prices
q OrdExUnits
HKD Identity OrdExUnits
r OrdExUnits
HKD Identity OrdExUnits
s Natural
HKD Identity Natural
t Natural
HKD Identity Natural
u Natural
HKD Identity Natural
v

instance Crypto c => FromCBOR (LegacyPParams (BabbageEra c)) where
  fromCBOR :: forall s. Decoder s (LegacyPParams (BabbageEra c))
fromCBOR =
    Version
-> Decoder s (LegacyPParams (BabbageEra c))
-> Decoder s (LegacyPParams (BabbageEra c))
forall s a. Version -> Decoder s a -> Decoder s a
toPlainDecoder (forall era. Era era => Version
eraProtVerLow @(BabbageEra c)) (Decoder s (LegacyPParams (BabbageEra c))
 -> Decoder s (LegacyPParams (BabbageEra c)))
-> Decoder s (LegacyPParams (BabbageEra c))
-> Decoder s (LegacyPParams (BabbageEra c))
forall a b. (a -> b) -> a -> b
$
      Decode ('Closed 'Dense) (LegacyPParams (BabbageEra c))
-> Decoder s (LegacyPParams (BabbageEra c))
forall (w :: Wrapped) t s. Decode w t -> Decoder s t
decode (Decode ('Closed 'Dense) (LegacyPParams (BabbageEra c))
 -> Decoder s (LegacyPParams (BabbageEra c)))
-> Decode ('Closed 'Dense) (LegacyPParams (BabbageEra c))
-> Decoder s (LegacyPParams (BabbageEra c))
forall a b. (a -> b) -> a -> b
$
        (Coin
 -> Coin
 -> Word32
 -> Word32
 -> Word16
 -> Coin
 -> Coin
 -> EpochInterval
 -> Natural
 -> NonNegativeInterval
 -> UnitInterval
 -> UnitInterval
 -> ProtVer
 -> Coin
 -> CoinPerByte
 -> CostModels
 -> Prices
 -> OrdExUnits
 -> OrdExUnits
 -> Natural
 -> Natural
 -> Natural
 -> LegacyPParams (BabbageEra c))
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall t. t -> Decode ('Closed 'Dense) t
RecD Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> ProtVer
-> Coin
-> CoinPerByte
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (BabbageEra c)
mkLegacyBabbagePParams
          Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppMinFeeA
          Decode
  ('Closed 'Dense)
  (Coin
   -> Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Word32
      -> Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppMinFeeB
          Decode
  ('Closed 'Dense)
  (Word32
   -> Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Word32
-> Decode
     ('Closed 'Dense)
     (Word32
      -> Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word32
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppMaxBBSize
          Decode
  ('Closed 'Dense)
  (Word32
   -> Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Word32
-> Decode
     ('Closed 'Dense)
     (Word16
      -> Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word32
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppMaxTxSize
          Decode
  ('Closed 'Dense)
  (Word16
   -> Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Word16
-> Decode
     ('Closed 'Dense)
     (Coin
      -> Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) Word16
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppMaxBHSize
          Decode
  ('Closed 'Dense)
  (Coin
   -> Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (Coin
      -> EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppKeyDeposit
          Decode
  ('Closed 'Dense)
  (Coin
   -> EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (EpochInterval
      -> Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppPoolDeposit
          Decode
  ('Closed 'Dense)
  (EpochInterval
   -> Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) EpochInterval
-> Decode
     ('Closed 'Dense)
     (Natural
      -> NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) EpochInterval
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppEMax
          Decode
  ('Closed 'Dense)
  (Natural
   -> NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (NonNegativeInterval
      -> UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppNOpt
          Decode
  ('Closed 'Dense)
  (NonNegativeInterval
   -> UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) NonNegativeInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppA0
          Decode
  ('Closed 'Dense)
  (UnitInterval
   -> UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (UnitInterval
      -> ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppRho
          Decode
  ('Closed 'Dense)
  (UnitInterval
   -> ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) UnitInterval
-> Decode
     ('Closed 'Dense)
     (ProtVer
      -> Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppTau
          Decode
  ('Closed 'Dense)
  (ProtVer
   -> Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed 'Dense) ProtVer
-> Decode
     ('Closed 'Dense)
     (Coin
      -> CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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 Decoder s ProtVer
forall s. Decoder s ProtVer
forall a s. DecCBORGroup a => Decoder s a
decCBORGroup -- bppProtocolVersion
          Decode
  ('Closed 'Dense)
  (Coin
   -> CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Coin
-> Decode
     ('Closed 'Dense)
     (CoinPerByte
      -> CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppMinPoolCost
          Decode
  ('Closed 'Dense)
  (CoinPerByte
   -> CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) CoinPerByte
-> Decode
     ('Closed 'Dense)
     (CostModels
      -> Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) CoinPerByte
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppCoinsPerUTxOByte
          Decode
  ('Closed 'Dense)
  (CostModels
   -> Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) CostModels
-> Decode
     ('Closed 'Dense)
     (Prices
      -> OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppCostModels
          Decode
  ('Closed 'Dense)
  (Prices
   -> OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Prices
-> Decode
     ('Closed 'Dense)
     (OrdExUnits
      -> OrdExUnits
      -> Natural
      -> Natural
      -> Natural
      -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- bppPrices
          Decode
  ('Closed 'Dense)
  (OrdExUnits
   -> OrdExUnits
   -> Natural
   -> Natural
   -> Natural
   -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) OrdExUnits
-> Decode
     ('Closed 'Dense)
     (OrdExUnits
      -> Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) OrdExUnits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppMaxTxExUnits
          Decode
  ('Closed 'Dense)
  (OrdExUnits
   -> Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) OrdExUnits
-> Decode
     ('Closed 'Dense)
     (Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
forall (w1 :: Wrapped) a t (w :: Density).
Decode w1 (a -> t) -> Decode ('Closed w) a -> Decode w1 t
<! Decode ('Closed Any) OrdExUnits
forall t (w :: Wrapped). DecCBOR t => Decode w t
From -- bppMaxBlockExUnits
          Decode
  ('Closed 'Dense)
  (Natural -> Natural -> Natural -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense)
     (Natural -> Natural -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- maxValSize
          Decode
  ('Closed 'Dense)
  (Natural -> Natural -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Natural
-> Decode
     ('Closed 'Dense) (Natural -> LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- collateralPercentage
          Decode ('Closed 'Dense) (Natural -> LegacyPParams (BabbageEra c))
-> Decode ('Closed Any) Natural
-> Decode ('Closed 'Dense) (LegacyPParams (BabbageEra c))
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). DecCBOR t => Decode w t
From -- maxCollateralInputs
    where
      mkLegacyBabbagePParams :: Coin
-> Coin
-> Word32
-> Word32
-> Word16
-> Coin
-> Coin
-> EpochInterval
-> Natural
-> NonNegativeInterval
-> UnitInterval
-> UnitInterval
-> ProtVer
-> Coin
-> CoinPerByte
-> CostModels
-> Prices
-> OrdExUnits
-> OrdExUnits
-> Natural
-> Natural
-> Natural
-> LegacyPParams (BabbageEra c)
mkLegacyBabbagePParams Coin
a Coin
b Word32
c Word32
d Word16
e Coin
f Coin
g EpochInterval
h Natural
i NonNegativeInterval
j UnitInterval
k UnitInterval
l ProtVer
m Coin
n CoinPerByte
o CostModels
p Prices
q OrdExUnits
r OrdExUnits
s Natural
t Natural
u Natural
v =
        PParams (BabbageEra c) -> LegacyPParams (BabbageEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (BabbageEra c) -> LegacyPParams (BabbageEra c))
-> PParams (BabbageEra c) -> LegacyPParams (BabbageEra c)
forall a b. (a -> b) -> a -> b
$
          PParamsHKD Identity (BabbageEra c) -> PParams (BabbageEra c)
forall era. PParamsHKD Identity era -> PParams era
PParams (PParamsHKD Identity (BabbageEra c) -> PParams (BabbageEra c))
-> PParamsHKD Identity (BabbageEra c) -> PParams (BabbageEra c)
forall a b. (a -> b) -> a -> b
$
            forall (f :: * -> *) era.
HKD f Coin
-> HKD f Coin
-> HKD f Word32
-> HKD f Word32
-> HKD f Word16
-> HKD f Coin
-> HKD f Coin
-> HKD f EpochInterval
-> HKD f Natural
-> HKD f NonNegativeInterval
-> HKD f UnitInterval
-> HKD f UnitInterval
-> HKD f ProtVer
-> HKD f Coin
-> HKD f CoinPerByte
-> HKD f CostModels
-> HKD f Prices
-> HKD f OrdExUnits
-> HKD f OrdExUnits
-> HKD f Natural
-> HKD f Natural
-> HKD f Natural
-> BabbagePParams f era
BabbagePParams @Identity @(BabbageEra c) Coin
HKD Identity Coin
a Coin
HKD Identity Coin
b Word32
HKD Identity Word32
c Word32
HKD Identity Word32
d Word16
HKD Identity Word16
e Coin
HKD Identity Coin
f Coin
HKD Identity Coin
g EpochInterval
HKD Identity EpochInterval
h Natural
HKD Identity Natural
i HKD Identity NonNegativeInterval
NonNegativeInterval
j HKD Identity UnitInterval
UnitInterval
k HKD Identity UnitInterval
UnitInterval
l HKD Identity ProtVer
ProtVer
m Coin
HKD Identity Coin
n CoinPerByte
HKD Identity CoinPerByte
o CostModels
HKD Identity CostModels
p Prices
HKD Identity Prices
q OrdExUnits
HKD Identity OrdExUnits
r OrdExUnits
HKD Identity OrdExUnits
s Natural
HKD Identity Natural
t Natural
HKD Identity Natural
u Natural
HKD Identity Natural
v

instance Crypto c => ToCBOR (LegacyPParams (ConwayEra c)) where
  toCBOR :: LegacyPParams (ConwayEra c) -> Encoding
toCBOR (LegacyPParams PParams (ConwayEra c)
pp) = PParams (ConwayEra c) -> Encoding
forall a. ToCBOR a => a -> Encoding
toCBOR PParams (ConwayEra c)
pp

instance Crypto c => FromCBOR (LegacyPParams (ConwayEra c)) where
  fromCBOR :: forall s. Decoder s (LegacyPParams (ConwayEra c))
fromCBOR = PParams (ConwayEra c) -> LegacyPParams (ConwayEra c)
forall era. PParams era -> LegacyPParams era
LegacyPParams (PParams (ConwayEra c) -> LegacyPParams (ConwayEra c))
-> Decoder s (PParams (ConwayEra c))
-> Decoder s (LegacyPParams (ConwayEra c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Decoder s (PParams (ConwayEra c))
forall s. Decoder s (PParams (ConwayEra c))
forall a s. FromCBOR a => Decoder s a
fromCBOR