{-# LANGUAGE TypeFamilies #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Mary.PParams () where

import Cardano.Ledger.Core
import Cardano.Ledger.Mary.Era (MaryEra)
import Cardano.Ledger.Shelley.Governance (
  EraGov (..),
  ShelleyGovState (..),
  curPParamsShelleyGovStateL,
  emptyShelleyGovState,
  futurePParamsShelleyGovStateL,
  prevPParamsShelleyGovStateL,
 )
import Cardano.Ledger.Shelley.PParams
import Data.Coerce
import Lens.Micro

instance EraPParams MaryEra where
  type PParamsHKD f MaryEra = ShelleyPParams f MaryEra

  type UpgradePParams f MaryEra = ()
  type DowngradePParams f MaryEra = ()

  emptyPParamsIdentity :: PParamsHKD Identity MaryEra
emptyPParamsIdentity = forall era. Era era => ShelleyPParams Identity era
emptyShelleyPParams
  emptyPParamsStrictMaybe :: PParamsHKD StrictMaybe MaryEra
emptyPParamsStrictMaybe = forall era. ShelleyPParams StrictMaybe era
emptyShelleyPParamsUpdate

  upgradePParamsHKD :: forall (f :: * -> *).
(HKDApplicative f, EraPParams (PreviousEra MaryEra)) =>
UpgradePParams f MaryEra
-> PParamsHKD f (PreviousEra MaryEra) -> PParamsHKD f MaryEra
upgradePParamsHKD () = coerce :: forall a b. Coercible a b => a -> b
coerce
  downgradePParamsHKD :: forall (f :: * -> *).
(HKDFunctor f, EraPParams (PreviousEra MaryEra)) =>
DowngradePParams f MaryEra
-> PParamsHKD f MaryEra -> PParamsHKD f (PreviousEra MaryEra)
downgradePParamsHKD () = coerce :: forall a b. Coercible a b => a -> b
coerce

  hkdMinFeeAL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Coin)
hkdMinFeeAL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinFeeA forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Coin
x -> PParamsHKD f MaryEra
pp {sppMinFeeA :: HKD f Coin
sppMinFeeA = HKD f Coin
x}
  hkdMinFeeBL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Coin)
hkdMinFeeBL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinFeeB forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Coin
x -> PParamsHKD f MaryEra
pp {sppMinFeeB :: HKD f Coin
sppMinFeeB = HKD f Coin
x}
  hkdMaxBBSizeL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Word32)
hkdMaxBBSizeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word32
sppMaxBBSize forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Word32
x -> PParamsHKD f MaryEra
pp {sppMaxBBSize :: HKD f Word32
sppMaxBBSize = HKD f Word32
x}
  hkdMaxTxSizeL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Word32)
hkdMaxTxSizeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word32
sppMaxTxSize forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Word32
x -> PParamsHKD f MaryEra
pp {sppMaxTxSize :: HKD f Word32
sppMaxTxSize = HKD f Word32
x}
  hkdMaxBHSizeL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Word16)
hkdMaxBHSizeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word16
sppMaxBHSize forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Word16
x -> PParamsHKD f MaryEra
pp {sppMaxBHSize :: HKD f Word16
sppMaxBHSize = HKD f Word16
x}
  hkdKeyDepositL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Coin)
hkdKeyDepositL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppKeyDeposit forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Coin
x -> PParamsHKD f MaryEra
pp {sppKeyDeposit :: HKD f Coin
sppKeyDeposit = HKD f Coin
x}
  hkdPoolDepositL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Coin)
hkdPoolDepositL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppPoolDeposit forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Coin
x -> PParamsHKD f MaryEra
pp {sppPoolDeposit :: HKD f Coin
sppPoolDeposit = HKD f Coin
x}
  hkdEMaxL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f EpochInterval)
hkdEMaxL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f EpochInterval
sppEMax forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f EpochInterval
x -> PParamsHKD f MaryEra
pp {sppEMax :: HKD f EpochInterval
sppEMax = HKD f EpochInterval
x}
  hkdNOptL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Word16)
hkdNOptL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Word16
sppNOpt forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Word16
x -> PParamsHKD f MaryEra
pp {sppNOpt :: HKD f Word16
sppNOpt = HKD f Word16
x}
  hkdA0L :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f NonNegativeInterval)
hkdA0L = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f NonNegativeInterval
sppA0 forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f NonNegativeInterval
x -> PParamsHKD f MaryEra
pp {sppA0 :: HKD f NonNegativeInterval
sppA0 = HKD f NonNegativeInterval
x}
  hkdRhoL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f UnitInterval)
hkdRhoL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppRho forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f UnitInterval
x -> PParamsHKD f MaryEra
pp {sppRho :: HKD f UnitInterval
sppRho = HKD f UnitInterval
x}
  hkdTauL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f UnitInterval)
hkdTauL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppTau forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f UnitInterval
x -> PParamsHKD f MaryEra
pp {sppTau :: HKD f UnitInterval
sppTau = HKD f UnitInterval
x}
  hkdDL :: forall (f :: * -> *).
(HKDFunctor f, ProtVerAtMost MaryEra 6) =>
Lens' (PParamsHKD f MaryEra) (HKD f UnitInterval)
hkdDL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era.
ShelleyPParams f era -> HKD f UnitInterval
sppD forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f UnitInterval
x -> PParamsHKD f MaryEra
pp {sppD :: HKD f UnitInterval
sppD = HKD f UnitInterval
x}
  hkdExtraEntropyL :: forall (f :: * -> *).
(HKDFunctor f, ProtVerAtMost MaryEra 6) =>
Lens' (PParamsHKD f MaryEra) (HKD f Nonce)
hkdExtraEntropyL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Nonce
sppExtraEntropy forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Nonce
x -> PParamsHKD f MaryEra
pp {sppExtraEntropy :: HKD f Nonce
sppExtraEntropy = HKD f Nonce
x}
  hkdProtocolVersionL :: forall (f :: * -> *).
(HKDFunctor f, ProtVerAtMost MaryEra 8) =>
Lens' (PParamsHKD f MaryEra) (HKD f ProtVer)
hkdProtocolVersionL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f ProtVer
sppProtocolVersion forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f ProtVer
x -> PParamsHKD f MaryEra
pp {sppProtocolVersion :: HKD f ProtVer
sppProtocolVersion = HKD f ProtVer
x}
  hkdMinUTxOValueL :: forall (f :: * -> *).
(HKDFunctor f, ProtVerAtMost MaryEra 4) =>
Lens' (PParamsHKD f MaryEra) (HKD f Coin)
hkdMinUTxOValueL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinUTxOValue forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Coin
x -> PParamsHKD f MaryEra
pp {sppMinUTxOValue :: HKD f Coin
sppMinUTxOValue = HKD f Coin
x}
  hkdMinPoolCostL :: forall (f :: * -> *).
HKDFunctor f =>
Lens' (PParamsHKD f MaryEra) (HKD f Coin)
hkdMinPoolCostL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (f :: * -> *) era. ShelleyPParams f era -> HKD f Coin
sppMinPoolCost forall a b. (a -> b) -> a -> b
$ \PParamsHKD f MaryEra
pp HKD f Coin
x -> PParamsHKD f MaryEra
pp {sppMinPoolCost :: HKD f Coin
sppMinPoolCost = HKD f Coin
x}

instance EraGov MaryEra where
  type GovState MaryEra = ShelleyGovState MaryEra
  emptyGovState :: GovState MaryEra
emptyGovState = forall era. EraPParams era => ShelleyGovState era
emptyShelleyGovState

  getProposedPPUpdates :: GovState MaryEra -> Maybe (ProposedPPUpdates MaryEra)
getProposedPPUpdates = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ShelleyGovState era -> ProposedPPUpdates era
sgsCurProposals

  curPParamsGovStateL :: Lens' (GovState MaryEra) (PParams MaryEra)
curPParamsGovStateL = forall era. Lens' (ShelleyGovState era) (PParams era)
curPParamsShelleyGovStateL

  prevPParamsGovStateL :: Lens' (GovState MaryEra) (PParams MaryEra)
prevPParamsGovStateL = forall era. Lens' (ShelleyGovState era) (PParams era)
prevPParamsShelleyGovStateL

  futurePParamsGovStateL :: Lens' (GovState MaryEra) (FuturePParams MaryEra)
futurePParamsGovStateL = forall era. Lens' (ShelleyGovState era) (FuturePParams era)
futurePParamsShelleyGovStateL

  obligationGovState :: GovState MaryEra -> Obligations
obligationGovState = forall a b. a -> b -> a
const forall a. Monoid a => a
mempty