{-# LANGUAGE AllowAmbiguousTypes #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ConstraintKinds #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE UndecidableSuperClasses #-}
{-# OPTIONS_GHC -Wno-orphans #-}
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- RecordWildCards cause name shadowing warnings in ghc-8.10.
#if __GLASGOW_HASKELL__ < 900
{-# OPTIONS_GHC -Wno-name-shadowing #-}
#endif

-- | This module provides the necessary instances of `HasSpec`
--   and `HasSimpleRep` for the components of PParams. It hides
--   the fact that (PParams era) can have different underlying 'data' types
--   in each era, and provides (Term fn) selector functions
--   (e.g. minFeeA_, minFeeB_, etc.) for every PParam field (in every era).
--   The class EraPP provides this era parametric abstraction.
module Test.Cardano.Ledger.Constrained.Conway.SimplePParams (
  EraPP (..),
  SimplePParams (..),
  SimplePPUpdate (..),
  simplePParamsSpec,
  cSNothing_,
  cSJust_,
  succV_,
  minFeeA_,
  minFeeB_,
  maxBBSize_,
  maxTxSize_,
  maxBHSize_,
  keyDeposit_,
  poolDeposit_,
  eMax_,
  nOpt_,
  a0_,
  rho_,
  tau_,
  decentral_,
  protocolVersion_,
  minUTxOValue_,
  minPoolCost_,
  coinsPerUTxOWord_,
  costModels_,
  prices_,
  maxTxExUnits_,
  maxBlockExUnits_,
  maxValSize_,
  collateralPercentage_,
  maxCollateralInputs_,
  coinsPerUTxOByte_,
  poolVotingThresholds_,
  drepVotingThresholds_,
  committeeMinSize_,
  committeeMaxTermLength_,
  govActionLifetime_,
  govActionDeposit_,
  dRepDeposit_,
  dRepActivity_,
  minFeeRefScriptCostPerByte_,
)
where

import Cardano.Ledger.Allegra (Allegra)
import Cardano.Ledger.Alonzo (Alonzo)
import Cardano.Ledger.Alonzo.PParams
import Cardano.Ledger.Babbage (Babbage)
import Cardano.Ledger.BaseTypes hiding (inject)
import Cardano.Ledger.Coin
import Cardano.Ledger.Conway (Conway)
import Cardano.Ledger.Conway.Core
import Cardano.Ledger.Conway.PParams
import Cardano.Ledger.Conway.Scripts ()
import Cardano.Ledger.Mary (Mary)
import Cardano.Ledger.Plutus.CostModels (CostModels)
import Cardano.Ledger.Plutus.ExUnits
import Cardano.Ledger.Shelley (Shelley)
import Constrained hiding (Value)
import Constrained.Univ ()
import Data.Word
import Lens.Micro
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Allegra.Arbitrary ()
import Test.Cardano.Ledger.Alonzo.Arbitrary ()
import Test.Cardano.Ledger.Constrained.Conway.InstancesBasic

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

instance EraPP Shelley where
  subsetToPP :: SimplePParams Shelley -> PParams Shelley
subsetToPP = forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley
  ppToSubset :: PParams Shelley -> SimplePParams Shelley
ppToSubset PParams Shelley
x = forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era -> SimplePParams era -> SimplePParams era
dropAtMost4 PParams Shelley
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams Shelley
x
  updateToPPU :: SimplePPUpdate -> PParamsUpdate Shelley
updateToPPU SimplePPUpdate
x = (forall era.
(EraPParams era, ProtVerAtMost era 8) =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley) SimplePPUpdate
x
  ppuToUpdate :: PParamsUpdate Shelley -> SimplePPUpdate
ppuToUpdate PParamsUpdate Shelley
x = forall era.
(EraPParams era, ProtVerAtMost era 8) =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer PParamsUpdate Shelley
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate Shelley
x

instance EraPP Allegra where
  subsetToPP :: SimplePParams Allegra -> PParams Allegra
subsetToPP = forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley
  ppToSubset :: PParams Allegra -> SimplePParams Allegra
ppToSubset PParams Allegra
x = forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era -> SimplePParams era -> SimplePParams era
dropAtMost4 PParams Allegra
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams Allegra
x
  updateToPPU :: SimplePPUpdate -> PParamsUpdate Allegra
updateToPPU SimplePPUpdate
x = (forall era.
(EraPParams era, ProtVerAtMost era 8) =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley) SimplePPUpdate
x
  ppuToUpdate :: PParamsUpdate Allegra -> SimplePPUpdate
ppuToUpdate PParamsUpdate Allegra
x = forall era.
(EraPParams era, ProtVerAtMost era 8) =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer PParamsUpdate Allegra
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate Allegra
x

instance EraPP Mary where
  subsetToPP :: SimplePParams Mary -> PParams Mary
subsetToPP SimplePParams Mary
x = forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley SimplePParams Mary
x
  ppToSubset :: PParams Mary -> SimplePParams Mary
ppToSubset PParams Mary
x = forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era -> SimplePParams era -> SimplePParams era
dropAtMost4 PParams Mary
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams Mary
x
  updateToPPU :: SimplePPUpdate -> PParamsUpdate Mary
updateToPPU SimplePPUpdate
x = (forall era.
(EraPParams era, ProtVerAtMost era 8) =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley) SimplePPUpdate
x
  ppuToUpdate :: PParamsUpdate Mary -> SimplePPUpdate
ppuToUpdate PParamsUpdate Mary
x = forall era.
(EraPParams era, ProtVerAtMost era 8) =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer PParamsUpdate Mary
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate Mary
x

instance EraPP Alonzo where
  subsetToPP :: SimplePParams Alonzo -> PParams Alonzo
subsetToPP SimplePParams Alonzo
x = (forall era.
AlonzoEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftAlonzo SimplePParams Alonzo
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley) SimplePParams Alonzo
x
  ppToSubset :: PParams Alonzo -> SimplePParams Alonzo
ppToSubset PParams Alonzo
x = forall era.
AlonzoEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropAlonzo PParams Alonzo
x forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, ProtVerAtMost era 6) =>
PParams era -> SimplePParams era -> SimplePParams era
dropAtMost6 PParams Alonzo
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams Alonzo
x
  updateToPPU :: SimplePPUpdate -> PParamsUpdate Alonzo
updateToPPU SimplePPUpdate
x = (forall era.
AlonzoEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftAlonzo SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraPParams era, ProtVerAtMost era 8) =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley) SimplePPUpdate
x
  ppuToUpdate :: PParamsUpdate Alonzo -> SimplePPUpdate
ppuToUpdate PParamsUpdate Alonzo
x = forall era.
AlonzoEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropAlonzo PParamsUpdate Alonzo
x forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, ProtVerAtMost era 8) =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer PParamsUpdate Alonzo
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate Alonzo
x

instance EraPP Babbage where
  subsetToPP :: SimplePParams Babbage -> PParams Babbage
subsetToPP SimplePParams Babbage
x = (forall era.
BabbageEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftBabbage SimplePParams Babbage
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftAlonzo SimplePParams Babbage
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley) SimplePParams Babbage
x
  ppToSubset :: PParams Babbage -> SimplePParams Babbage
ppToSubset PParams Babbage
x = forall era.
BabbageEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropBabbage PParams Babbage
x forall a b. (a -> b) -> a -> b
$ forall era.
AlonzoEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropAlonzo PParams Babbage
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams Babbage
x
  updateToPPU :: SimplePPUpdate -> PParamsUpdate Babbage
updateToPPU SimplePPUpdate
x = (forall era.
BabbageEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftBabbage SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftAlonzo SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
(EraPParams era, ProtVerAtMost era 8) =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley) SimplePPUpdate
x
  ppuToUpdate :: PParamsUpdate Babbage -> SimplePPUpdate
ppuToUpdate PParamsUpdate Babbage
x = forall era.
BabbageEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropBabbage PParamsUpdate Babbage
x forall a b. (a -> b) -> a -> b
$ forall era.
AlonzoEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropAlonzo PParamsUpdate Babbage
x forall a b. (a -> b) -> a -> b
$ forall era.
(EraPParams era, ProtVerAtMost era 8) =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer PParamsUpdate Babbage
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate Babbage
x

instance EraPP Conway where
  subsetToPP :: SimplePParams Conway -> PParams Conway
subsetToPP SimplePParams Conway
x = (forall era.
ConwayEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftConway SimplePParams Conway
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
BabbageEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftBabbage SimplePParams Conway
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftAlonzo SimplePParams Conway
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley) SimplePParams Conway
x
  ppToSubset :: PParams Conway -> SimplePParams Conway
ppToSubset PParams Conway
x = forall era.
ConwayEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropConway PParams Conway
x forall a b. (a -> b) -> a -> b
$ forall era.
BabbageEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropBabbage PParams Conway
x forall a b. (a -> b) -> a -> b
$ forall era.
AlonzoEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropAlonzo PParams Conway
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams Conway
x
  updateToPPU :: SimplePPUpdate -> PParamsUpdate Conway
updateToPPU SimplePPUpdate
x = (forall era.
ConwayEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftConway SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
BabbageEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftBabbage SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
AlonzoEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftAlonzo SimplePPUpdate
x forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley) SimplePPUpdate
x
  ppuToUpdate :: PParamsUpdate Conway -> SimplePPUpdate
ppuToUpdate PParamsUpdate Conway
x = forall era.
ConwayEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropConway PParamsUpdate Conway
x forall a b. (a -> b) -> a -> b
$ forall era.
BabbageEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropBabbage PParamsUpdate Conway
x forall a b. (a -> b) -> a -> b
$ forall era.
AlonzoEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropAlonzo PParamsUpdate Conway
x forall a b. (a -> b) -> a -> b
$ forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate Conway
x

-- ====================================================================================
-- Since the transition from one Era to the next Era, we add or drop some of the
-- parameters. This we need some functions that lift and drop from one era to another
-- which add (or drop) the appropriate parameters.

unitI :: UnitInterval
unitI :: UnitInterval
unitI = Integer -> Integer -> UnitInterval
makeUnitInterval Integer
0 Integer
1

dropAtMost6 ::
  (EraPParams era, ProtVerAtMost era 6) => PParams era -> SimplePParams era -> SimplePParams era
dropAtMost6 :: forall era.
(EraPParams era, ProtVerAtMost era 6) =>
PParams era -> SimplePParams era -> SimplePParams era
dropAtMost6 PParams era
pp SimplePParams era
x = SimplePParams era
x {decentral :: UnitInterval
decentral = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL}

dropAtMost4 ::
  (EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
  PParams era ->
  SimplePParams era ->
  SimplePParams era
dropAtMost4 :: forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era -> SimplePParams era -> SimplePParams era
dropAtMost4 PParams era
pp SimplePParams era
x =
  SimplePParams era
x
    { minUTxOValue :: Coin
minUTxOValue = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 4) =>
Lens' (PParams era) Coin
ppMinUTxOValueL
    , decentral :: UnitInterval
decentral = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 6) =>
Lens' (PParams era) UnitInterval
ppDL
    }

-- Magic functions used to implement (EraPP era). Example use for Conway
--  subsetToPP x = (toPP . liftConway x . liftBabbage x . liftAlonzo x . liftShelley) x
--  ppToSubset x = dropConway x $ dropAlonzo x $ dropAlonzo x $ dropShelley x
dropShelley :: EraPParams era => PParams era -> SimplePParams era
dropShelley :: forall era. EraPParams era => PParams era -> SimplePParams era
dropShelley PParams era
pp =
  SimplePParams
    { minFeeA :: Coin
minFeeA = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL
    , minFeeB :: Coin
minFeeB = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL
    , maxBBSize :: Word32
maxBBSize = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxBBSizeL
    , maxTxSize :: Word32
maxTxSize = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL
    , maxBHSize :: Word32
maxBHSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Word16
ppMaxBHSizeL)
    , keyDeposit :: Coin
keyDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL
    , poolDeposit :: Coin
poolDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL
    , eMax :: EpochInterval
eMax = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) EpochInterval
ppEMaxL
    , nOpt :: Natural
nOpt = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Natural
ppNOptL
    , a0 :: NonNegativeInterval
a0 = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppA0L
    , rho :: UnitInterval
rho = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppRhoL
    , tau :: UnitInterval
tau = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppTauL
    , protocolVersion :: ProtVer
protocolVersion = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL
    , minPoolCost :: Coin
minPoolCost = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinPoolCostL
    , -- \^ In Shelley these are given default values
      decentral :: UnitInterval
decentral = UnitInterval
unitI -- in some Eras, dropAtMost6 will over ride this default
    , minUTxOValue :: Coin
minUTxOValue = Integer -> Coin
Coin Integer
0 -- in some Eras, dropAtMost4 will over ride this default
    , coinsPerUTxOWord :: Coin
coinsPerUTxOWord = Integer -> Coin
Coin Integer
0
    , costModels :: CostModels
costModels = forall a. Monoid a => a
mempty
    , prices :: Prices
prices = Integer -> Integer -> Prices
makePrices Integer
0 Integer
0
    , maxTxExUnits :: ExUnits
maxTxExUnits = forall a. Monoid a => a
mempty
    , maxBlockExUnits :: ExUnits
maxBlockExUnits = forall a. Monoid a => a
mempty
    , maxValSize :: Natural
maxValSize = Natural
0
    , collateralPercentage :: Natural
collateralPercentage = Natural
0
    , maxCollateralInputs :: Natural
maxCollateralInputs = Natural
0
    , coinsPerUTxOByte :: Coin
coinsPerUTxOByte = Integer -> Coin
Coin Integer
0
    , poolVotingThresholds :: PoolVotingThresholds
poolVotingThresholds = UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> PoolVotingThresholds
PoolVotingThresholds UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI
    , drepVotingThresholds :: DRepVotingThresholds
drepVotingThresholds =
        UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> UnitInterval
-> DRepVotingThresholds
DRepVotingThresholds UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI UnitInterval
unitI
    , committeeMinSize :: Natural
committeeMinSize = Natural
0
    , committeeMaxTermLength :: EpochInterval
committeeMaxTermLength = Word32 -> EpochInterval
EpochInterval Word32
0
    , govActionLifetime :: EpochInterval
govActionLifetime = Word32 -> EpochInterval
EpochInterval Word32
0
    , govActionDeposit :: Coin
govActionDeposit = Integer -> Coin
Coin Integer
0
    , dRepDeposit :: Coin
dRepDeposit = Integer -> Coin
Coin Integer
0
    , dRepActivity :: EpochInterval
dRepActivity = Word32 -> EpochInterval
EpochInterval Word32
0
    , minFeeRefScriptCostPerByte :: NonNegativeInterval
minFeeRefScriptCostPerByte = Integer -> Integer -> NonNegativeInterval
makeNonNegativeInterval Integer
0 Integer
1
    }

dropAlonzo :: AlonzoEraPParams era => PParams era -> SimplePParams era -> SimplePParams era
dropAlonzo :: forall era.
AlonzoEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropAlonzo PParams era
pp SimplePParams era
psub =
  SimplePParams era
psub
    { coinsPerUTxOWord :: Coin
coinsPerUTxOWord = Integer -> Coin
Coin Integer
0
    , costModels :: CostModels
costModels = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL
    , prices :: Prices
prices = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL
    , maxTxExUnits :: ExUnits
maxTxExUnits = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL
    , maxBlockExUnits :: ExUnits
maxBlockExUnits = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL
    , maxValSize :: Natural
maxValSize = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL
    , collateralPercentage :: Natural
collateralPercentage = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL
    }

dropBabbage :: BabbageEraPParams era => PParams era -> SimplePParams era -> SimplePParams era
dropBabbage :: forall era.
BabbageEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropBabbage PParams era
pp SimplePParams era
psub =
  SimplePParams era
psub {coinsPerUTxOByte :: Coin
coinsPerUTxOByte = CoinPerByte -> Coin
unCoinPerByte (PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL)}

dropConway :: ConwayEraPParams era => PParams era -> SimplePParams era -> SimplePParams era
dropConway :: forall era.
ConwayEraPParams era =>
PParams era -> SimplePParams era -> SimplePParams era
dropConway PParams era
pp SimplePParams era
psub =
  SimplePParams era
psub
    { poolVotingThresholds :: PoolVotingThresholds
poolVotingThresholds = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL
    , drepVotingThresholds :: DRepVotingThresholds
drepVotingThresholds = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL
    , committeeMinSize :: Natural
committeeMinSize = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL
    , committeeMaxTermLength :: EpochInterval
committeeMaxTermLength = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL
    , govActionLifetime :: EpochInterval
govActionLifetime = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL
    , govActionDeposit :: Coin
govActionDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL
    , dRepDeposit :: Coin
dRepDeposit = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL
    , dRepActivity :: EpochInterval
dRepActivity = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL
    , minFeeRefScriptCostPerByte :: NonNegativeInterval
minFeeRefScriptCostPerByte = PParams era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL
    }

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

liftShelley :: EraPParams era => SimplePParams era -> PParams era
liftShelley :: forall era. EraPParams era => SimplePParams era -> PParams era
liftShelley SimplePParams era
pps =
  forall era. EraPParams era => PParams era
emptyPParams
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
minFeeA SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
minFeeB SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxBBSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Word32
maxBBSize SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Word32
maxTxSize SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Word16
ppMaxBHSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall era. SimplePParams era -> Word32
maxBHSize SimplePParams era
pps))
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
keyDeposit SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
poolDeposit SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) EpochInterval
ppEMaxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> EpochInterval
eMax SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Natural
ppNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Natural
nOpt SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppA0L forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> NonNegativeInterval
a0 SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppRhoL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> UnitInterval
rho SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) UnitInterval
ppTauL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> UnitInterval
tau SimplePParams era
pps)
    -- & ppDL .~ (decentral pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> ProtVer
protocolVersion SimplePParams era
pps)
    -- & ppMinUTxOValueL .~ (minUTxOValue pps)
    forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) Coin
ppMinPoolCostL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
minPoolCost SimplePParams era
pps)

liftAlonzo :: AlonzoEraPParams era => SimplePParams era -> PParams era -> PParams era
liftAlonzo :: forall era.
AlonzoEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftAlonzo SimplePParams era
pps PParams era
pp =
  PParams era
pp -- & ppCoinsPerUTxOWordL .~  CoinPerWord (coinsPerUTxOWord pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) CostModels
ppCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> CostModels
costModels SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
ppPricesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Prices
prices SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> ExUnits
maxTxExUnits SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxBlockExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> ExUnits
maxBlockExUnits SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxValSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Natural
maxValSize SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Natural
collateralPercentage SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppMaxCollateralInputsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Natural
maxCollateralInputs SimplePParams era
pps)

liftBabbage :: BabbageEraPParams era => SimplePParams era -> PParams era -> PParams era
liftBabbage :: forall era.
BabbageEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftBabbage SimplePParams era
pps PParams era
pp = PParams era
pp forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraPParams era =>
Lens' (PParams era) CoinPerByte
ppCoinsPerUTxOByteL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin -> CoinPerByte
CoinPerByte (forall era. SimplePParams era -> Coin
coinsPerUTxOByte SimplePParams era
pps)

liftConway :: ConwayEraPParams era => SimplePParams era -> PParams era -> PParams era
liftConway :: forall era.
ConwayEraPParams era =>
SimplePParams era -> PParams era -> PParams era
liftConway SimplePParams era
pps PParams era
pp =
  PParams era
pp
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) PoolVotingThresholds
ppPoolVotingThresholdsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> PoolVotingThresholds
poolVotingThresholds SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) DRepVotingThresholds
ppDRepVotingThresholdsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> DRepVotingThresholds
drepVotingThresholds SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Natural
ppCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Natural
committeeMinSize SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppCommitteeMaxTermLengthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> EpochInterval
committeeMaxTermLength SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> EpochInterval
govActionLifetime SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
govActionDeposit SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> Coin
dRepDeposit SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> EpochInterval
dRepActivity SimplePParams era
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParams era) NonNegativeInterval
ppMinFeeRefScriptCostPerByteL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall era. SimplePParams era -> NonNegativeInterval
minFeeRefScriptCostPerByte SimplePParams era
pps)

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

uDropShelley :: EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley :: forall era. EraPParams era => PParamsUpdate era -> SimplePPUpdate
uDropShelley PParamsUpdate era
pp =
  SimplePPUpdate
    { uminFeeA :: StrictMaybe Coin
uminFeeA = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL
    , uminFeeB :: StrictMaybe Coin
uminFeeB = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeBL
    , umaxBBSize :: StrictMaybe Word32
umaxBBSize = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL
    , umaxTxSize :: StrictMaybe Word32
umaxTxSize = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL
    , umaxBHSize :: StrictMaybe Word32
umaxBHSize = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL)
    , ukeyDeposit :: StrictMaybe Coin
ukeyDeposit = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL
    , upoolDeposit :: StrictMaybe Coin
upoolDeposit = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL
    , ueMax :: StrictMaybe EpochInterval
ueMax = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuEMaxL
    , unOpt :: StrictMaybe Natural
unOpt = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuNOptL
    , ua0 :: StrictMaybe NonNegativeInterval
ua0 = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuA0L
    , urho :: StrictMaybe UnitInterval
urho = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuRhoL
    , utau :: StrictMaybe UnitInterval
utau = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuTauL
    , uminPoolCost :: StrictMaybe Coin
uminPoolCost = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinPoolCostL
    , -- In Shelley these are given SNothing values
      udecentral :: StrictMaybe UnitInterval
udecentral = forall a. StrictMaybe a
SNothing -- in some Eras, dropAtMost6 will over ride this default
    , uprotocolVersion :: StrictMaybe ProtVer
uprotocolVersion = forall a. StrictMaybe a
SNothing
    , uminUTxOValue :: StrictMaybe Coin
uminUTxOValue = forall a. StrictMaybe a
SNothing -- in some Eras, dropAtMost4 will over ride this default
    , ucoinsPerUTxOWord :: StrictMaybe Coin
ucoinsPerUTxOWord = forall a. StrictMaybe a
SNothing
    , ucostModels :: StrictMaybe CostModels
ucostModels = forall a. StrictMaybe a
SNothing
    , uprices :: StrictMaybe Prices
uprices = forall a. StrictMaybe a
SNothing
    , umaxTxExUnits :: StrictMaybe ExUnits
umaxTxExUnits = forall a. StrictMaybe a
SNothing
    , umaxBlockExUnits :: StrictMaybe ExUnits
umaxBlockExUnits = forall a. StrictMaybe a
SNothing
    , umaxValSize :: StrictMaybe Natural
umaxValSize = forall a. StrictMaybe a
SNothing
    , ucollateralPercentage :: StrictMaybe Natural
ucollateralPercentage = forall a. StrictMaybe a
SNothing
    , umaxCollateralInputs :: StrictMaybe Natural
umaxCollateralInputs = forall a. StrictMaybe a
SNothing
    , ucoinsPerUTxOByte :: StrictMaybe Coin
ucoinsPerUTxOByte = forall a. StrictMaybe a
SNothing
    , upoolVotingThresholds :: StrictMaybe PoolVotingThresholds
upoolVotingThresholds = forall a. StrictMaybe a
SNothing
    , udrepVotingThresholds :: StrictMaybe DRepVotingThresholds
udrepVotingThresholds = forall a. StrictMaybe a
SNothing
    , ucommitteeMinSize :: StrictMaybe Natural
ucommitteeMinSize = forall a. StrictMaybe a
SNothing
    , ucommitteeMaxTermLength :: StrictMaybe EpochInterval
ucommitteeMaxTermLength = forall a. StrictMaybe a
SNothing
    , ugovActionLifetime :: StrictMaybe EpochInterval
ugovActionLifetime = forall a. StrictMaybe a
SNothing
    , ugovActionDeposit :: StrictMaybe Coin
ugovActionDeposit = forall a. StrictMaybe a
SNothing
    , udRepDeposit :: StrictMaybe Coin
udRepDeposit = forall a. StrictMaybe a
SNothing
    , udRepActivity :: StrictMaybe EpochInterval
udRepActivity = forall a. StrictMaybe a
SNothing
    , uminFeeRefScriptCostPerByte :: StrictMaybe NonNegativeInterval
uminFeeRefScriptCostPerByte = forall a. StrictMaybe a
SNothing
    }

uDropProtVer ::
  (EraPParams era, ProtVerAtMost era 8) => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer :: forall era.
(EraPParams era, ProtVerAtMost era 8) =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropProtVer PParamsUpdate era
pp SimplePPUpdate
psub = SimplePPUpdate
psub {uprotocolVersion :: StrictMaybe ProtVer
uprotocolVersion = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
ppuProtocolVersionL}

uDropAlonzo :: AlonzoEraPParams era => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropAlonzo :: forall era.
AlonzoEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropAlonzo PParamsUpdate era
pp SimplePPUpdate
psub =
  SimplePPUpdate
psub
    { -- ucoinsPerUTxOWord = unCoinPerWord <$> pp ^. ppuCoinsPerUTxOWordL
      ucostModels :: StrictMaybe CostModels
ucostModels = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
ppuCostModelsL
    , uprices :: StrictMaybe Prices
uprices = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Prices)
ppuPricesL
    , umaxTxExUnits :: StrictMaybe ExUnits
umaxTxExUnits = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
ppuMaxTxExUnitsL
    , umaxBlockExUnits :: StrictMaybe ExUnits
umaxBlockExUnits = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
ppuMaxBlockExUnitsL
    , umaxValSize :: StrictMaybe Natural
umaxValSize = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuMaxValSizeL
    , ucollateralPercentage :: StrictMaybe Natural
ucollateralPercentage = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCollateralPercentageL
    , umaxCollateralInputs :: StrictMaybe Natural
umaxCollateralInputs = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuMaxCollateralInputsL
    }

uDropBabbage :: BabbageEraPParams era => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropBabbage :: forall era.
BabbageEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropBabbage PParamsUpdate era
pp SimplePPUpdate
psub =
  SimplePPUpdate
psub {ucoinsPerUTxOByte :: StrictMaybe Coin
ucoinsPerUTxOByte = CoinPerByte -> Coin
unCoinPerByte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
ppuCoinsPerUTxOByteL)}

uDropConway :: ConwayEraPParams era => PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropConway :: forall era.
ConwayEraPParams era =>
PParamsUpdate era -> SimplePPUpdate -> SimplePPUpdate
uDropConway PParamsUpdate era
pp SimplePPUpdate
psub =
  SimplePPUpdate
psub
    { upoolVotingThresholds :: StrictMaybe PoolVotingThresholds
upoolVotingThresholds = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
ppuPoolVotingThresholdsL
    , udrepVotingThresholds :: StrictMaybe DRepVotingThresholds
udrepVotingThresholds = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
ppuDRepVotingThresholdsL
    , ucommitteeMinSize :: StrictMaybe Natural
ucommitteeMinSize = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL
    , ucommitteeMaxTermLength :: StrictMaybe EpochInterval
ucommitteeMaxTermLength = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuCommitteeMaxTermLengthL
    , ugovActionLifetime :: StrictMaybe EpochInterval
ugovActionLifetime = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuGovActionLifetimeL
    , ugovActionDeposit :: StrictMaybe Coin
ugovActionDeposit = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuGovActionDepositL
    , udRepDeposit :: StrictMaybe Coin
udRepDeposit = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL
    , udRepActivity :: StrictMaybe EpochInterval
udRepActivity = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuDRepActivityL
    , uminFeeRefScriptCostPerByte :: StrictMaybe NonNegativeInterval
uminFeeRefScriptCostPerByte = PParamsUpdate era
pp forall s a. s -> Getting a s a -> a
^. forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuMinFeeRefScriptCostPerByteL
    }

uLiftShelley :: EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley :: forall era. EraPParams era => SimplePPUpdate -> PParamsUpdate era
uLiftShelley SimplePPUpdate
pps =
  forall era. EraPParams era => PParamsUpdate era
emptyPParamsUpdate
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeAL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
uminFeeA SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinFeeBL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
uminFeeB SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxBBSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Word32
umaxBBSize SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word32)
ppuMaxTxSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Word32
umaxTxSize SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Word16)
ppuMaxBHSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SimplePPUpdate -> StrictMaybe Word32
umaxBHSize SimplePPUpdate
pps))
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuKeyDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
ukeyDeposit SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuPoolDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
upoolDeposit SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuEMaxL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe EpochInterval
ueMax SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuNOptL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Natural
unOpt SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuA0L forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe NonNegativeInterval
ua0 SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuRhoL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe UnitInterval
urho SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe UnitInterval)
ppuTauL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe UnitInterval
utau SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinPoolCostL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
uminPoolCost SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
EraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuMinPoolCostL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
uminPoolCost SimplePPUpdate
pps)

uLiftProtVer ::
  (EraPParams era, ProtVerAtMost era 8) => SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer :: forall era.
(EraPParams era, ProtVerAtMost era 8) =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftProtVer SimplePPUpdate
pps PParamsUpdate era
pp = PParamsUpdate era
pp forall a b. a -> (a -> b) -> b
& forall era.
(EraPParams era, ProtVerAtMost era 8) =>
Lens' (PParamsUpdate era) (StrictMaybe ProtVer)
ppuProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe ProtVer
uprotocolVersion SimplePPUpdate
pps)

uLiftAlonzo :: AlonzoEraPParams era => SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftAlonzo :: forall era.
AlonzoEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftAlonzo SimplePPUpdate
pps PParamsUpdate era
pp =
  PParamsUpdate era
pp
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CostModels)
ppuCostModelsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe CostModels
ucostModels SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Prices)
ppuPricesL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Prices
uprices SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
ppuMaxTxExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe ExUnits
umaxTxExUnits SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe ExUnits)
ppuMaxBlockExUnitsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe ExUnits
umaxBlockExUnits SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuMaxValSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Natural
umaxValSize SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCollateralPercentageL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Natural
ucollateralPercentage SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
AlonzoEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuMaxCollateralInputsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Natural
umaxCollateralInputs SimplePPUpdate
pps)

uLiftBabbage :: BabbageEraPParams era => SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftBabbage :: forall era.
BabbageEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftBabbage SimplePPUpdate
pps PParamsUpdate era
pp = PParamsUpdate era
pp forall a b. a -> (a -> b) -> b
& forall era.
BabbageEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe CoinPerByte)
ppuCoinsPerUTxOByteL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Coin -> CoinPerByte
CoinPerByte forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (SimplePPUpdate -> StrictMaybe Coin
ucoinsPerUTxOByte SimplePPUpdate
pps))

uLiftConway :: ConwayEraPParams era => SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftConway :: forall era.
ConwayEraPParams era =>
SimplePPUpdate -> PParamsUpdate era -> PParamsUpdate era
uLiftConway SimplePPUpdate
pps PParamsUpdate era
pp =
  PParamsUpdate era
pp
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe PoolVotingThresholds)
ppuPoolVotingThresholdsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe PoolVotingThresholds
upoolVotingThresholds SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe DRepVotingThresholds)
ppuDRepVotingThresholdsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe DRepVotingThresholds
udrepVotingThresholds SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Natural)
ppuCommitteeMinSizeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Natural
ucommitteeMinSize SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuCommitteeMaxTermLengthL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe EpochInterval
ucommitteeMaxTermLength SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuGovActionLifetimeL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe EpochInterval
ugovActionLifetime SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuGovActionDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
ugovActionDeposit SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe Coin)
ppuDRepDepositL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe Coin
udRepDeposit SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe EpochInterval)
ppuDRepActivityL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe EpochInterval
udRepActivity SimplePPUpdate
pps)
    forall a b. a -> (a -> b) -> b
& forall era.
ConwayEraPParams era =>
Lens' (PParamsUpdate era) (StrictMaybe NonNegativeInterval)
ppuMinFeeRefScriptCostPerByteL forall s t a b. ASetter s t a b -> b -> s -> t
.~ (SimplePPUpdate -> StrictMaybe NonNegativeInterval
uminFeeRefScriptCostPerByte SimplePPUpdate
pps)

-- ============================================================================
-- Term Selectors for SimplePParams

minFeeA_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
minFeeA_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
minFeeA_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @0 Term fn (SimplePParams era)
simplepp

minFeeB_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
minFeeB_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
minFeeB_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @1 Term fn (SimplePParams era)
simplepp

maxBBSize_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Word32
maxBBSize_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Word32
maxBBSize_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @2 Term fn (SimplePParams era)
simplepp

maxTxSize_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Word32
maxTxSize_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Word32
maxTxSize_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @3 Term fn (SimplePParams era)
simplepp

maxBHSize_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Word32
maxBHSize_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Word32
maxBHSize_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @4 Term fn (SimplePParams era)
simplepp

keyDeposit_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
keyDeposit_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
keyDeposit_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @5 Term fn (SimplePParams era)
simplepp

poolDeposit_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
poolDeposit_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
poolDeposit_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @6 Term fn (SimplePParams era)
simplepp

eMax_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn EpochInterval
eMax_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
eMax_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @7 Term fn (SimplePParams era)
simplepp

nOpt_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Natural
nOpt_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
nOpt_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @8 Term fn (SimplePParams era)
simplepp

a0_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn NonNegativeInterval
a0_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn NonNegativeInterval
a0_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @9 Term fn (SimplePParams era)
simplepp

rho_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn UnitInterval
rho_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn UnitInterval
rho_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @10 Term fn (SimplePParams era)
simplepp

tau_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn UnitInterval
tau_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn UnitInterval
tau_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @11 Term fn (SimplePParams era)
simplepp

decentral_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn UnitInterval
decentral_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn UnitInterval
decentral_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @12 Term fn (SimplePParams era)
simplepp

protocolVersion_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn ProtVer
protocolVersion_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn ProtVer
protocolVersion_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @13 Term fn (SimplePParams era)
simplepp

minUTxOValue_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
minUTxOValue_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
minUTxOValue_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @14 Term fn (SimplePParams era)
simplepp

minPoolCost_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
minPoolCost_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
minPoolCost_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @15 Term fn (SimplePParams era)
simplepp

coinsPerUTxOWord_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
coinsPerUTxOWord_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
coinsPerUTxOWord_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @16 Term fn (SimplePParams era)
simplepp

costModels_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn CostModels
costModels_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn CostModels
costModels_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @17 Term fn (SimplePParams era)
simplepp

prices_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Prices
prices_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Prices
prices_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @18 Term fn (SimplePParams era)
simplepp

maxTxExUnits_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn ExUnits
maxTxExUnits_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn ExUnits
maxTxExUnits_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @19 Term fn (SimplePParams era)
simplepp

maxBlockExUnits_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn ExUnits
maxBlockExUnits_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn ExUnits
maxBlockExUnits_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @20 Term fn (SimplePParams era)
simplepp

maxValSize_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Natural
maxValSize_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
maxValSize_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @21 Term fn (SimplePParams era)
simplepp

collateralPercentage_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Natural
collateralPercentage_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
collateralPercentage_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @22 Term fn (SimplePParams era)
simplepp

maxCollateralInputs_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Natural
maxCollateralInputs_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
maxCollateralInputs_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @23 Term fn (SimplePParams era)
simplepp

coinsPerUTxOByte_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
coinsPerUTxOByte_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
coinsPerUTxOByte_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @24 Term fn (SimplePParams era)
simplepp

poolVotingThresholds_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn PoolVotingThresholds
poolVotingThresholds_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn PoolVotingThresholds
poolVotingThresholds_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @25 Term fn (SimplePParams era)
simplepp

drepVotingThresholds_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn DRepVotingThresholds
drepVotingThresholds_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn DRepVotingThresholds
drepVotingThresholds_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @26 Term fn (SimplePParams era)
simplepp

committeeMinSize_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Natural
committeeMinSize_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
committeeMinSize_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @27 Term fn (SimplePParams era)
simplepp

committeeMaxTermLength_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn EpochInterval
committeeMaxTermLength_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
committeeMaxTermLength_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @28 Term fn (SimplePParams era)
simplepp

govActionLifetime_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn EpochInterval
govActionLifetime_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
govActionLifetime_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @29 Term fn (SimplePParams era)
simplepp

govActionDeposit_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
govActionDeposit_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
govActionDeposit_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @30 Term fn (SimplePParams era)
simplepp

dRepDeposit_ :: (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn Coin
dRepDeposit_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
dRepDeposit_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @31 Term fn (SimplePParams era)
simplepp

dRepActivity_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn EpochInterval
dRepActivity_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
dRepActivity_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @32 Term fn (SimplePParams era)
simplepp

minFeeRefScriptCostPerByte_ ::
  (EraPP era, BaseUniverse fn) => Term fn (SimplePParams era) -> Term fn NonNegativeInterval
minFeeRefScriptCostPerByte_ :: forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn NonNegativeInterval
minFeeRefScriptCostPerByte_ Term fn (SimplePParams era)
simplepp = forall (n :: Natural) (fn :: [*] -> * -> *) a (c :: Symbol)
       (as :: [*]).
(SimpleRep a ~ ProdOver as, TheSop a ~ '[c ::: as],
 TypeSpec fn a ~ TypeSpec fn (ProdOver as), Select fn n as,
 HasSpec fn a, HasSpec fn (ProdOver as), HasSimpleRep a) =>
Term fn a -> Term fn (At n as)
sel @33 Term fn (SimplePParams era)
simplepp

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

-- | A sample of how to constrain (PParams era) for every Era, by writing a specification for SimplePParams.
--   Constrained but not applicable fields (for that era) are elided in the result.
--   Missing fields are left unconstrained and will appear as random values in the result.
--   This can easily be lifted to PParams: see Test.Cardano.Ledger.Constrained.Conway.PParams(pparamsSpec)
simplePParamsSpec ::
  forall fn era. (EraPP era, BaseUniverse fn) => Specification fn (SimplePParams era)
simplePParamsSpec :: forall (fn :: [*] -> * -> *) era.
(EraPP era, BaseUniverse fn) =>
Specification fn (SimplePParams era)
simplePParamsSpec = forall a (fn :: [*] -> * -> *) p.
(IsPred p fn, HasSpec fn a) =>
(Term fn a -> p) -> Specification fn a
constrained forall a b. (a -> b) -> a -> b
$ \Term fn (SimplePParams era)
pp ->
  [ forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn ProtVer
protocolVersion_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
==. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit (Version -> Natural -> ProtVer
ProtVer (forall (v :: Natural). (KnownNat v, 0 <= v, v <= 11) => Version
natVersion @10) Natural
0)
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Word32
maxBBSize_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit Word32
0
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Word32
maxTxSize_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit Word32
0
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Word32
maxBHSize_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit Word32
0
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
maxValSize_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit Natural
0
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Natural
collateralPercentage_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit Natural
0
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
committeeMaxTermLength_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit (Word32 -> EpochInterval
EpochInterval Word32
0)
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
govActionLifetime_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit (Word32 -> EpochInterval
EpochInterval Word32
0)
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
poolDeposit_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit forall a. Monoid a => a
mempty
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
govActionDeposit_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit forall a. Monoid a => a
mempty
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn Coin
dRepDeposit_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
/=. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit forall a. Monoid a => a
mempty
  , forall (fn :: [*] -> * -> *) p a.
(HasSpec fn a, IsProductType fn a, IsPred p fn) =>
Term fn a
-> FunTy (MapList (Term fn) (ProductAsList a)) p -> Pred fn
match (forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn EpochInterval
eMax_ Term fn (SimplePParams era)
pp) (\Term fn Word32
epochInterval -> forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit Word32
0 forall a (fn :: [*] -> * -> *).
(Ord a, OrdLike fn a) =>
Term fn a -> Term fn a -> Term fn Bool
<. Term fn Word32
epochInterval)
  , forall (fn :: [*] -> * -> *) p.
(BaseUniverse fn, IsPred p fn) =>
p -> Pred fn
assert forall a b. (a -> b) -> a -> b
$ forall era (fn :: [*] -> * -> *).
(EraPP era, BaseUniverse fn) =>
Term fn (SimplePParams era) -> Term fn CostModels
costModels_ Term fn (SimplePParams era)
pp forall (fn :: [*] -> * -> *) a.
HasSpec fn a =>
Term fn a -> Term fn a -> Term fn Bool
==. forall a (fn :: [*] -> * -> *). Show a => a -> Term fn a
lit forall a. Monoid a => a
mempty -- This makes examples soo much more readable.
  ]