{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}

module Test.Cardano.Ledger.Constrained.Vars where

import Cardano.Crypto.Signing (SigningKey)
import Cardano.Ledger.Address (Addr (..), Withdrawals (..))
import Cardano.Ledger.Allegra.Scripts (ValidityInterval (..))
import Cardano.Ledger.Alonzo.PParams (AlonzoEraPParams, ppCollateralPercentageL, ppMaxTxExUnitsL)
import Cardano.Ledger.Alonzo.Tx (IsValid (..), ScriptIntegrityHash)
import Cardano.Ledger.Alonzo.TxWits (TxDats (..))
import Cardano.Ledger.Alonzo.UTxO (AlonzoScriptsNeeded (..))
import Cardano.Ledger.AuxiliaryData (AuxiliaryDataHash)
import Cardano.Ledger.BaseTypes (
  BlocksMade (..),
  EpochNo,
  Globals (..),
  Network (..),
  ProtVer (..),
  SlotNo (..),
  StrictMaybe (..),
  UnitInterval,
 )
import qualified Cardano.Ledger.BaseTypes as Base (EpochInterval (..), Globals (..))
import Cardano.Ledger.CertState (
  CommitteeAuthorization (..),
  CommitteeState (..),
  csCommitteeCredsL,
  vsNumDormantEpochsL,
 )
import Cardano.Ledger.Coin (Coin (..), CompactForm (CompactCoin), DeltaCoin)
import Cardano.Ledger.Conway.Governance hiding (GovState)
import Cardano.Ledger.Conway.PParams (
  ConwayEraPParams,
  ppDRepActivityL,
  ppDRepDepositL,
  ppGovActionDepositL,
 )
import Cardano.Ledger.Core (
  Era (EraCrypto),
  PParams,
  TxOut,
  TxWits,
  Value,
  addrTxOutL,
  coinTxOutL,
  ppEMaxL,
  ppKeyDepositL,
  ppMaxBBSizeL,
  ppMaxBHSizeL,
  ppMaxTxSizeL,
  ppMinFeeAL,
  ppMinFeeBL,
  ppPoolDepositL,
  ppProtocolVersionL,
  valueTxOutL,
 )
import Cardano.Ledger.Credential (Credential, Ptr)
import Cardano.Ledger.DRep (DRep (..), DRepState (..))
import Cardano.Ledger.EpochBoundary (SnapShot (..), SnapShots (..), Stake (..))
import Cardano.Ledger.Hashes (DataHash, EraIndependentScriptIntegrity, ScriptHash (..))
import Cardano.Ledger.Keys (GenDelegPair, GenDelegs (..), KeyHash, KeyRole (..))
import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness)
import Cardano.Ledger.Keys.WitVKey (WitVKey (..))
import Cardano.Ledger.Mary.Value (AssetName (..), MaryValue (..), MultiAsset (..), PolicyID (..))
import Cardano.Ledger.Plutus (ExUnits (..))
import Cardano.Ledger.Plutus.Data (Data (..), Datum (..))
import Cardano.Ledger.PoolDistr (IndividualPoolStake (..), PoolDistr (..), poolDistrDistrL)
import Cardano.Ledger.PoolParams (PoolParams)
import Cardano.Ledger.SafeHash (SafeHash)
import Cardano.Ledger.Shelley.Governance (FuturePParams (..), futureProposalsL, proposalsL)
import qualified Cardano.Ledger.Shelley.Governance as Gov
import Cardano.Ledger.Shelley.HardForks as HardForks (allowMIRTransfer)
import Cardano.Ledger.Shelley.LedgerState hiding (
  credMapL,
  delegations,
  deltaReserves,
  deltaTreasury,
  ptrMap,
  ptrMapL,
  rewards,
 )
import Cardano.Ledger.Shelley.PParams (ProposedPPUpdates (..))
import Cardano.Ledger.Shelley.PoolRank (NonMyopic (..))
import qualified Cardano.Ledger.Shelley.RewardUpdate as RU
import Cardano.Ledger.Shelley.Rewards (Reward (..))
import Cardano.Ledger.Shelley.TxBody (RewardAccount (..))
import Cardano.Ledger.Shelley.UTxO (EraUTxO (..), ShelleyScriptsNeeded (..))
import Cardano.Ledger.TxIn (TxIn (..))
import Cardano.Ledger.UMap (compactCoinOrError, fromCompact, ptrMap, rdPairMap, sPoolMap, unify)
import Cardano.Ledger.UTxO (UTxO (..))
import Cardano.Ledger.Val (Val (..))
import Control.Arrow (first)
import Data.Default (Default (def))
import Data.Foldable (toList)
import qualified Data.Foldable as F
import Data.Functor.Identity (Identity)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (maybeToStrictMaybe, strictMaybeToMaybe)
import qualified Data.OMap.Strict as OMap
import Data.Ratio ((%))
import qualified Data.Sequence.Strict as SS
import Data.Set (Set)
import qualified Data.VMap as VMap
import Data.Word (Word16, Word32, Word64)
import GHC.Stack (HasCallStack)
import Lens.Micro
import Numeric.Natural (Natural)
import Test.Cardano.Ledger.Babbage.Serialisation.Generators ()
import Test.Cardano.Ledger.Constrained.Ast
import Test.Cardano.Ledger.Constrained.Classes (
  GovState (..),
  PParamsF (..),
  PParamsUpdateF (..),
  PlutusPointerF (..),
  PlutusPurposeF (..),
  ScriptF (..),
  ScriptsNeededF (..),
  TxAuxDataF (..),
  TxBodyF (..),
  TxCertF (..),
  TxF (..),
  TxOutF (..),
  TxWitsF (..),
  ValueF (..),
  liftUTxO,
  pparamsWrapperL,
  unPParamsUpdate,
  unPlutusPointerF,
  unPlutusPurposeF,
  unScriptF,
  unTxCertF,
  unTxOut,
  unValue,
 )
import Test.Cardano.Ledger.Constrained.Env (
  Access (..),
  AnyF (..),
  Field (..),
  Name (..),
  V (..),
  pV,
 )
import Test.Cardano.Ledger.Constrained.Lenses
import Test.Cardano.Ledger.Constrained.TypeRep (Rep (..), testEql, (:~:) (Refl))
import Test.Cardano.Ledger.Core.KeyPair (KeyPair (..))
import Test.Cardano.Ledger.Generic.Fields (TxBodyField (..), TxField (..), WitnessesField (..))
import qualified Test.Cardano.Ledger.Generic.Fields as Fields
import Test.Cardano.Ledger.Generic.Functions (protocolVersion)
import Test.Cardano.Ledger.Generic.GenState (mkRedeemers)
import Test.Cardano.Ledger.Generic.PrettyCore (ppString, withEraPParams)
import Test.Cardano.Ledger.Generic.Proof
import Test.Cardano.Ledger.Generic.Updaters (merge, newPParams, newTx, newTxBody, newWitnesses)
import Test.Cardano.Ledger.Shelley.Utils (testGlobals)
import qualified Test.Cardano.Ledger.Shelley.Utils as Utils (testGlobals)
import Type.Reflection (Typeable, typeRep)

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

-- | Used in Component constraints to turn a Var Term into a component (AnyF era s)
-- E.g.  (Component foo [ field fooRep fooPart1, field fooRep fooPart2])
-- Where fooPart1 :: Term era a, and fooPart2 :: Term era b
-- And fooPart1 has an (Access foo a)
-- And fooPart2 has an (Access foo b)
field :: Era era => Rep era s -> Term era t -> AnyF era s
field :: forall era s t. Era era => Rep era s -> Term era t -> AnyF era s
field Rep era s
repS1 (Var (V String
name Rep era t
rept (Yes Rep era s
repS2 Lens' s t
l))) = case forall {k} (t :: k -> *) (i :: k) (j :: k).
Singleton t =>
t i -> t j -> Maybe (i :~: j)
testEql Rep era s
repS1 Rep era s
repS2 of
  Just s :~: s
Refl -> forall era s t. Field era s t -> AnyF era s
AnyF (forall era t s.
Era era =>
String -> Rep era t -> Rep era s -> Lens' s t -> Field era s t
Field String
name Rep era t
rept Rep era s
repS2 Lens' s t
l)
  Maybe (s :~: s)
Nothing ->
    forall a. HasCallStack => String -> a
error
      ( [String] -> String
unlines
          [ String
"Given rep and lens target do not match: "
          , String
"rep: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep era s
repS1
          , String
"lens target: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Rep era s
repS2
          ]
      )
field Rep era s
_ Term era t
term = forall a. HasCallStack => String -> a
error (String
"field can only be applied to variable terms: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Term era t
term)

getName :: Term era t -> Name era
getName :: forall era t. Term era t -> Name era
getName (Var V era t
v) = forall era t. V era t -> Name era
Name V era t
v
getName Term era t
x = forall a. HasCallStack => String -> a
error (String
"nameOf can't find the name in: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Term era t
x)

-- ==============================================================
-- NewEpochState fields

type NELens era t = Lens' (NewEpochState era) t

currentEpoch :: Era era => Term era EpochNo
currentEpoch :: forall era. Era era => Term era EpochNo
currentEpoch = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"currentEpoch" forall era. Rep era EpochNo
EpochR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. Lens' (NewEpochState era) EpochNo
nesELL))

prevBlocksMade :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
prevBlocksMade :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
prevBlocksMade = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"prevBlocksMade" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Rep era Natural
NaturalR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
Lens'
  (NewEpochState era)
  (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
nesBprevL)

currBlocksMade :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
currBlocksMade :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
currBlocksMade = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"currBlocksMade" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Rep era Natural
NaturalR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
Lens'
  (NewEpochState era)
  (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
nesBcurL)

poolDistr ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
poolDistr :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
poolDistr = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"poolDistr" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era.
Era era =>
Rep era (IndividualPoolStake (EraCrypto era))
IPoolStakeR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
poolDistrL)

-- | For tests only, Like PoolDistr but has a Rational (rather than a IndividualPoolStake).
mockPoolDistr :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) Rational)
mockPoolDistr :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) Rational)
mockPoolDistr = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"mockPoolDistr" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Rep era Rational
RationalR) forall era s t. Access era s t
No

poolDistrL ::
  NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
poolDistrL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
poolDistrL = forall era. Lens' (NewEpochState era) (PoolDistr (EraCrypto era))
nesPdL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (PoolDistr c) (Map (KeyHash 'StakePool c) (IndividualPoolStake c))
poolDistrDistrL

-- CertState - DState

rewards :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
rewards :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
rewards = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"rewards" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
rewardsL)

rewardsL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
rewardsL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
rewardsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (UMap c) (Map (Credential 'Staking c) Coin)
rewardsUMapL

delegations ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
delegations :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
delegations = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"delegations" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
delegationsL)

delegationsL ::
  NELens era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
delegationsL :: forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
delegationsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (UMap c) (Map (Credential 'Staking c) (KeyHash 'StakePool c))
delegationsUMapL

stakeDeposits :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
stakeDeposits :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
stakeDeposits = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"stakeDeposits" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
stakeDepositsL)

stakeDepositsL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
stakeDepositsL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
stakeDepositsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (UMap c) (Map (Credential 'Staking c) Coin)
stakeDepositsUMapL

ptrs :: Era era => Term era (Map Ptr (Credential 'Staking (EraCrypto era)))
ptrs :: forall era.
Era era =>
Term era (Map Ptr (Credential 'Staking (EraCrypto era)))
ptrs = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"ptrs" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Rep era Ptr
PtrR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map Ptr (Credential 'Staking (EraCrypto era)))
ptrsL)

ptrsL :: NELens era (Map Ptr (Credential 'Staking (EraCrypto era)))
ptrsL :: forall era.
NELens era (Map Ptr (Credential 'Staking (EraCrypto era)))
ptrsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (UMap c) (Map Ptr (Credential 'Staking c))
ptrsUMapL

currentDRepState ::
  Era era => Term era (Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
currentDRepState :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
currentDRepState = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"currentDRepState" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'DRepRole (EraCrypto era))
VCredR forall era. Era era => Rep era (DRepState (EraCrypto era))
DRepStateR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
drepsL)

drepsL :: NELens era (Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
drepsL :: forall era.
NELens
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
drepsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (VState era)
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
vsDRepsL

drepDelegation ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegation :: forall era.
Era era =>
Term
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegation = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"drepDelegation" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Era era => Rep era (DRep (EraCrypto era))
DRepR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegationL)

drepDelegationL :: NELens era (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegationL :: forall era.
NELens
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegationL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) (UMap (EraCrypto era))
dsUnifiedL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (UMap c) (Map (Credential 'Staking c) (DRep c))
drepUMapL

futureGenDelegs ::
  Era era => Term era (Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
futureGenDelegs :: forall era.
Era era =>
Term
  era
  (Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
futureGenDelegs =
  forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$
    forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V
      String
"futureGenDelegs"
      (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (FutureGenDeleg (EraCrypto era))
FutureGenDelegR forall era. Era era => Rep era (GenDelegPair (EraCrypto era))
GenDelegPairR)
      (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
futureGenDelegsL)

futureGenDelegsL :: NELens era (Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
futureGenDelegsL :: forall era.
NELens
  era
  (Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
futureGenDelegsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DState era)
  (Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
dsFutureGenDelegsL

genDelegs ::
  Era era => Term era (Map (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genDelegs :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genDelegs = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"genDelegs" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'Genesis (EraCrypto era))
GenHashR forall era. Era era => Rep era (GenDelegPair (EraCrypto era))
GenDelegPairR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genDelegsL)

genDelegsL :: NELens era (Map (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genDelegsL :: forall era.
NELens
  era
  (Map
     (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genDelegsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (DState era) (GenDelegs (EraCrypto era))
dsGenDelegsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (GenDelegs c) (Map (KeyHash 'Genesis c) (GenDelegPair c))
unGenDelegsL

-- DState - InstantaneousRewards

instanReserves :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanReserves :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanReserves = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"instanReserves" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanReservesL)

instanReservesL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanReservesL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanReservesL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (DState era) (InstantaneousRewards (EraCrypto era))
dsIRewardsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (InstantaneousRewards c) (Map (Credential 'Staking c) Coin)
iRReservesL

instanReservesSum :: Era era => Term era Coin
instanReservesSum :: forall era. Era era => Term era Coin
instanReservesSum = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"instanReservesSum" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

instanTreasury :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanTreasury :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanTreasury = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"instanTreasury" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanTreasuryL)

instanTreasuryL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanTreasuryL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
instanTreasuryL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (DState era) (InstantaneousRewards (EraCrypto era))
dsIRewardsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (InstantaneousRewards c) (Map (Credential 'Staking c) Coin)
iRTreasuryL

instanTreasurySum :: Era era => Term era Coin
instanTreasurySum :: forall era. Era era => Term era Coin
instanTreasurySum = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"instanTreasurySum" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

deltaReserves :: Era era => Term era DeltaCoin
deltaReserves :: forall era. Era era => Term era DeltaCoin
deltaReserves = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"deltaReserves" forall era. Rep era DeltaCoin
DeltaCoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era DeltaCoin
deltaReservesNEL)

deltaReservesNEL :: NELens era DeltaCoin
deltaReservesNEL :: forall era. NELens era DeltaCoin
deltaReservesNEL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (DState era) (InstantaneousRewards (EraCrypto era))
dsIRewardsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (InstantaneousRewards c) DeltaCoin
deltaReservesL

deltaTreasury :: Era era => Term era DeltaCoin
deltaTreasury :: forall era. Era era => Term era DeltaCoin
deltaTreasury = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"deltaTreasury" forall era. Rep era DeltaCoin
DeltaCoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era DeltaCoin
deltaTreasuryNEL)

deltaTreasuryNEL :: NELens era DeltaCoin
deltaTreasuryNEL :: forall era. NELens era DeltaCoin
deltaTreasuryNEL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (DState era)
certDStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (DState era) (InstantaneousRewards (EraCrypto era))
dsIRewardsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (InstantaneousRewards c) DeltaCoin
deltaTreasuryL

-- CertState - PState

regPools ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPools :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPools = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"regPools" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Era era => Rep era (PoolParams (EraCrypto era))
PoolParamsR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPoolsL)

regPoolsL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPoolsL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPoolsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (PState era)
certPStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (PState era)
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
psStakePoolParamsL

futureRegPools ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
futureRegPools :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
futureRegPools = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"futureRegPools" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Era era => Rep era (PoolParams (EraCrypto era))
PoolParamsR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
futureRegPoolsL)

futureRegPoolsL ::
  NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
futureRegPoolsL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
futureRegPoolsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (PState era)
certPStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (PState era)
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
psFutureStakePoolParamsL

retiring :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
retiring :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
retiring = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"retiring" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Rep era EpochNo
EpochR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
retiringL)

retiringL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
retiringL :: forall era.
NELens era (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
retiringL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (PState era)
certPStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (PState era) (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
psRetiringL

poolDeposits :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
poolDeposits :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
poolDeposits = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"poolDeposits" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
poolDepositsL)

poolDepositsL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
poolDepositsL :: forall era.
NELens era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
poolDepositsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (PState era)
certPStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (PState era) (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
psDepositsL

committeeState ::
  Era era =>
  Term
    era
    (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (CommitteeAuthorization (EraCrypto era)))
committeeState :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
committeeState =
  forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$
    forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"committeeState" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'ColdCommitteeRole (EraCrypto era))
CommColdCredR forall era.
Era era =>
Rep era (CommitteeAuthorization (EraCrypto era))
CommitteeAuthorizationR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
committeeStateL)

committeeStateL ::
  NELens
    era
    (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (CommitteeAuthorization (EraCrypto era)))
committeeStateL :: forall era.
NELens
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
committeeStateL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (VState era) (CommitteeState era)
vsCommitteeStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (CommitteeState era)
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
csCommitteeCredsL

numDormantEpochs :: Era era => Term era EpochNo
numDormantEpochs :: forall era. Era era => Term era EpochNo
numDormantEpochs = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"numDormantEpochs" forall era. Rep era EpochNo
EpochR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. Lens' (NewEpochState era) EpochNo
numDormantEpochsL)

numDormantEpochsL :: NELens era EpochNo
numDormantEpochsL :: forall era. Lens' (NewEpochState era) EpochNo
numDormantEpochsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (CertState era) (VState era)
certVStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (VState era) EpochNo
vsNumDormantEpochsL

-- UTxOState

utxo :: Era era => Proof era -> Term era (Map (TxIn (EraCrypto era)) (TxOutF era))
utxo :: forall era.
Era era =>
Proof era -> Term era (Map (TxIn (EraCrypto era)) (TxOutF era))
utxo Proof era
p = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"utxo" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (TxIn (EraCrypto era))
TxInR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof era
p)) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR (forall era.
Proof era -> NELens era (Map (TxIn (EraCrypto era)) (TxOutF era))
utxoL Proof era
p))

utxoL :: Proof era -> NELens era (Map (TxIn (EraCrypto era)) (TxOutF era))
utxoL :: forall era.
Proof era -> NELens era (Map (TxIn (EraCrypto era)) (TxOutF era))
utxoL Proof era
proof = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (UTxO era)
utxosUtxoL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Proof era
-> Lens' (UTxO era) (Map (TxIn (EraCrypto era)) (TxOutF era))
unUtxoL Proof era
proof

unUtxoL :: Proof era -> Lens' (UTxO era) (Map (TxIn (EraCrypto era)) (TxOutF era))
unUtxoL :: forall era.
Proof era
-> Lens' (UTxO era) (Map (TxIn (EraCrypto era)) (TxOutF era))
unUtxoL Proof era
p = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. UTxO era -> Map (TxIn (EraCrypto era)) (TxOut era)
unUTxO) (\(UTxO Map (TxIn (EraCrypto era)) (TxOut era)
_) Map (TxIn (EraCrypto era)) (TxOutF era)
new -> forall era. Map (TxIn (EraCrypto era)) (TxOutF era) -> UTxO era
liftUTxO Map (TxIn (EraCrypto era)) (TxOutF era)
new)

deposits :: Era era => Term era Coin
deposits :: forall era. Era era => Term era Coin
deposits = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"deposits" forall era. Rep era Coin
CoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era Coin
depositsL)

depositsL :: NELens era Coin
depositsL :: forall era. NELens era Coin
depositsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) Coin
utxosDepositedL

fees :: Era era => Term era Coin
fees :: forall era. Era era => Term era Coin
fees = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"fees" forall era. Rep era Coin
CoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era Coin
feesL)

feesL :: NELens era Coin
feesL :: forall era. NELens era Coin
feesL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) Coin
utxosFeesL

donation :: Era era => Term era Coin
donation :: forall era. Era era => Term era Coin
donation = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"donation" forall era. Rep era Coin
CoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era Coin
donationL)

donationL :: NELens era Coin
donationL :: forall era. NELens era Coin
donationL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) Coin
utxosDonationL

ppup :: Era era => Proof era -> Term era (ShelleyGovState era)
ppup :: forall era. Era era => Proof era -> Term era (ShelleyGovState era)
ppup Proof era
p = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"ppup" (forall era. Era era => Proof era -> Rep era (ShelleyGovState era)
PPUPStateR Proof era
p) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR (forall era. Proof era -> NELens era (ShelleyGovState era)
ppupsL Proof era
p))

ppupsL :: Proof era -> NELens era (ShelleyGovState era)
ppupsL :: forall era. Proof era -> NELens era (ShelleyGovState era)
ppupsL Proof era
Shelley = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
ppupsL Proof era
Allegra = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
ppupsL Proof era
Mary = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
ppupsL Proof era
Alonzo = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
ppupsL Proof era
Babbage = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL
ppupsL Proof era
Conway = forall a. HasCallStack => String -> a
error String
"Conway era does not have a PPUPState, in ppupsL"

pparamProposals ::
  Era era => Proof era -> Term era (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
pparamProposals :: forall era.
Era era =>
Proof era
-> Term
     era (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
pparamProposals Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"pparamProposals" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'Genesis (EraCrypto era))
GenHashR (forall era. Era era => Proof era -> Rep era (PParamsUpdateF era)
PParamsUpdateR Proof era
p)) forall era s t. Access era s t
No)

futurePParamProposals ::
  Era era => Proof era -> Term era (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
futurePParamProposals :: forall era.
Era era =>
Proof era
-> Term
     era (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
futurePParamProposals Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"futurePParamProposals" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'Genesis (EraCrypto era))
GenHashR (forall era. Era era => Proof era -> Rep era (PParamsUpdateF era)
PParamsUpdateR Proof era
p)) forall era s t. Access era s t
No)

currPParams :: Era era => Proof era -> Term era (PParamsF era)
currPParams :: forall era. Era era => Proof era -> Term era (PParamsF era)
currPParams Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"currPParams" (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) forall era s t. Access era s t
No)

futurePParams :: Era era => Proof era -> Term era (FuturePParams era)
futurePParams :: forall era. Era era => Proof era -> Term era (FuturePParams era)
futurePParams Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"futurePParams" (forall era. Era era => Proof era -> Rep era (FuturePParams era)
FuturePParamsR Proof era
p) forall era s t. Access era s t
No)

prevPParams :: Gov.EraGov era => Proof era -> Term era (PParamsF era)
prevPParams :: forall era. EraGov era => Proof era -> Term era (PParamsF era)
prevPParams Proof era
p =
  forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"prevPParams" (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
ppFL Proof era
p)))

ppupStateT ::
  forall era.
  ( Gov.GovState era ~ ShelleyGovState era
  , Gov.EraGov era
  ) =>
  Proof era ->
  RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT :: forall era.
(GovState era ~ ShelleyGovState era, EraGov era) =>
Proof era
-> RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT Proof era
p =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"PPUPState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(ShelleyGovState era)) forall {era}.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
-> Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
-> PParamsF era
-> PParamsF era
-> FuturePParams era
-> ShelleyGovState era
ppupfun
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed (forall era.
Era era =>
Proof era
-> Term
     era (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
pparamProposals Proof era
p) (forall era. Lens' (ShelleyGovState era) (ProposedPPUpdates era)
proposalsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Proof era
-> Lens'
     (ProposedPPUpdates era)
     (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
proposedMapL Proof era
p)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed (forall era.
Era era =>
Proof era
-> Term
     era (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
futurePParamProposals Proof era
p) (forall era. Lens' (ShelleyGovState era) (ProposedPPUpdates era)
futureProposalsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Proof era
-> Lens'
     (ProposedPPUpdates era)
     (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
proposedMapL Proof era
p)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed (forall era. Era era => Proof era -> Term era (PParamsF era)
currPParams Proof era
p) (forall era. EraGov era => Lens' (GovState era) (PParams era)
Gov.curPParamsGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL Proof era
p)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed (forall era. EraGov era => Proof era -> Term era (PParamsF era)
prevPParams Proof era
p) (forall era. EraGov era => Lens' (GovState era) (PParams era)
Gov.prevPParamsGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL Proof era
p)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed (forall era. Era era => Proof era -> Term era (FuturePParams era)
futurePParams Proof era
p) (forall era. EraGov era => Lens' (GovState era) (FuturePParams era)
Gov.futurePParamsGovStateL)
  where
    ppupfun :: Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
-> Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
-> PParamsF era
-> PParamsF era
-> FuturePParams era
-> ShelleyGovState era
ppupfun Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
x Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
y (PParamsF Proof era
_ PParams era
pp) (PParamsF Proof era
_ PParams era
prev) FuturePParams era
z =
      forall era.
ProposedPPUpdates era
-> ProposedPPUpdates era
-> PParams era
-> PParams era
-> FuturePParams era
-> ShelleyGovState era
ShelleyGovState
        (forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
x))
        (forall era.
Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
-> ProposedPPUpdates era
ProposedPPUpdates (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
y))
        PParams era
pp
        PParams era
prev
        FuturePParams era
z

govL :: Lens' (GovState era) (Gov.GovState era)
govL :: forall era. Lens' (GovState era) (GovState era)
govL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. GovState era -> GovState era
f forall era. GovState era -> GovState era -> GovState era
g
  where
    f :: GovState era -> Gov.GovState era
    f :: forall era. GovState era -> GovState era
f (GovState Proof era
Shelley GovState era
x) = GovState era
x
    f (GovState Proof era
Allegra GovState era
x) = GovState era
x
    f (GovState Proof era
Mary GovState era
x) = GovState era
x
    f (GovState Proof era
Alonzo GovState era
x) = GovState era
x
    f (GovState Proof era
Babbage GovState era
x) = GovState era
x
    f (GovState Proof era
Conway GovState era
x) = GovState era
x
    g :: GovState era -> Gov.GovState era -> GovState era
    g :: forall era. GovState era -> GovState era -> GovState era
g (GovState p :: Proof era
p@Proof era
Shelley GovState era
_) GovState era
y = forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
y
    g (GovState p :: Proof era
p@Proof era
Allegra GovState era
_) GovState era
y = forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
y
    g (GovState p :: Proof era
p@Proof era
Mary GovState era
_) GovState era
y = forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
y
    g (GovState p :: Proof era
p@Proof era
Alonzo GovState era
_) GovState era
y = forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
y
    g (GovState p :: Proof era
p@Proof era
Babbage GovState era
_) GovState era
y = forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
y
    g (GovState p :: Proof era
p@Proof era
Conway GovState era
_) GovState era
y = forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
y

govStateT :: forall era. Era era => Proof era -> RootTarget era (GovState era) (GovState era)
govStateT :: forall era.
Era era =>
Proof era -> RootTarget era (GovState era) (GovState era)
govStateT p :: Proof era
p@Proof era
Shelley = forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovState era)) (forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p) forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift (forall era.
(GovState era ~ ShelleyGovState era, EraGov era) =>
Proof era
-> RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT Proof era
p) forall era. Lens' (GovState era) (GovState era)
govL
govStateT p :: Proof era
p@Proof era
Allegra = forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovState era)) (forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p) forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift (forall era.
(GovState era ~ ShelleyGovState era, EraGov era) =>
Proof era
-> RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT Proof era
p) forall era. Lens' (GovState era) (GovState era)
govL
govStateT p :: Proof era
p@Proof era
Mary = forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovState era)) (forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p) forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift (forall era.
(GovState era ~ ShelleyGovState era, EraGov era) =>
Proof era
-> RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT Proof era
p) forall era. Lens' (GovState era) (GovState era)
govL
govStateT p :: Proof era
p@Proof era
Alonzo = forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovState era)) (forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p) forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift (forall era.
(GovState era ~ ShelleyGovState era, EraGov era) =>
Proof era
-> RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT Proof era
p) forall era. Lens' (GovState era) (GovState era)
govL
govStateT p :: Proof era
p@Proof era
Babbage = forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovState era)) (forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p) forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift (forall era.
(GovState era ~ ShelleyGovState era, EraGov era) =>
Proof era
-> RootTarget era (ShelleyGovState era) (ShelleyGovState era)
ppupStateT Proof era
p) forall era. Lens' (GovState era) (GovState era)
govL
govStateT p :: Proof era
p@Proof era
Conway =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovState era)) (forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p) forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift (forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect forall era.
(RunConwayRatify era, Reflect era) =>
Proof era
-> RootTarget era (ConwayGovState era) (ConwayGovState era)
conwayGovStateT Proof era
p) forall era. Lens' (GovState era) (GovState era)
govL

individualPoolStakeL :: Lens' (IndividualPoolStake c) Rational
individualPoolStakeL :: forall c. Lens' (IndividualPoolStake c) Rational
individualPoolStakeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c. IndividualPoolStake c -> Rational
individualPoolStake (\IndividualPoolStake c
ds Rational
u -> IndividualPoolStake c
ds {individualPoolStake :: Rational
individualPoolStake = Rational
u})

-- Incremental Stake

isPtrMapT :: Era era => Term era (Map Ptr Coin)
isPtrMapT :: forall era. Era era => Term era (Map Ptr Coin)
isPtrMapT = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"ptrMap" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Rep era Ptr
PtrR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. Lens' (NewEpochState era) (Map Ptr Coin)
ptrMapL)

ptrMapL :: Lens' (NewEpochState era) (Map Ptr Coin)
ptrMapL :: forall era. Lens' (NewEpochState era) (Map Ptr Coin)
ptrMapL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (UTxOState era) (IncrementalStake (EraCrypto era))
utxosStakeDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (IncrementalStake c) (Map Ptr Coin)
isPtrMapL

isCredMapT :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
isCredMapT :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
isCredMapT = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"credMap" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
credMapL)

credMapL :: Lens' (NewEpochState era) (Map (Credential 'Staking (EraCrypto era)) Coin)
credMapL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
credMapL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (LedgerState era)
esLStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (UTxOState era) (IncrementalStake (EraCrypto era))
utxosStakeDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (IncrementalStake c) (Map (Credential 'Staking c) Coin)
isCredMapL

-- | This variable is computed from the UTxO and the PParams,
--   It represents the incremental stake that is computed by 'smartUTxO'
--   in the UTxOState Target UTxOStateT
--   The domain of this map is the complete set of credentials used to delegate Coin
--   in the TxOuts in the UTxO.
incrementalStake :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
incrementalStake :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
incrementalStake = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"incrementalStake" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) forall era s t. Access era s t
No

incrementalStakeT ::
  Reflect era => Proof era -> Target era (Map (Credential 'Staking (EraCrypto era)) Coin)
incrementalStakeT :: forall era.
Reflect era =>
Proof era
-> Target era (Map (Credential 'Staking (EraCrypto era)) Coin)
incrementalStakeT Proof era
proof = forall t r era. String -> (t -> r) -> RootTarget era Void (t -> r)
Constr String
"computeIncrementalStake" Map (TxIn StandardCrypto) (TxOutF era)
-> Map (Credential 'Staking StandardCrypto) Coin
get forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (forall era.
Era era =>
Proof era -> Term era (Map (TxIn (EraCrypto era)) (TxOutF era))
utxo Proof era
proof)
  where
    get :: Map (TxIn StandardCrypto) (TxOutF era)
-> Map (Credential 'Staking StandardCrypto) Coin
get Map (TxIn StandardCrypto) (TxOutF era)
utxom =
      let IStake Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stakeDistr Map Ptr (CompactForm Coin)
_ = forall era.
EraTxOut era =>
PParams era
-> IncrementalStake (EraCrypto era)
-> UTxO era
-> UTxO era
-> IncrementalStake (EraCrypto era)
updateStakeDistribution (forall era. Reflect era => Proof era -> PParams era
justProtocolVersion Proof era
proof) forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (forall era. Map (TxIn (EraCrypto era)) (TxOutF era) -> UTxO era
liftUTxO Map (TxIn StandardCrypto) (TxOutF era)
utxom)
       in forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stakeDistr

-- ==========================
-- AccountState

treasury :: Era era => Term era Coin
treasury :: forall era. Era era => Term era Coin
treasury = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"treasury" forall era. Rep era Coin
CoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era Coin
treasuryL)

treasuryL :: NELens era Coin
treasuryL :: forall era. NELens era Coin
treasuryL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asTreasuryL

reserves :: Era era => Term era Coin
reserves :: forall era. Era era => Term era Coin
reserves = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"reserves" forall era. Rep era Coin
CoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era Coin
reservesL)

reservesL :: NELens era Coin
reservesL :: forall era. NELens era Coin
reservesL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) AccountState
esAccountStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' AccountState Coin
asReservesL

-- | The Coin availabe for a MIR transfer to/from the Treasury
--   Computed from 'treasury' + 'deltaTreasury' - sum('instanTreasury')
mirAvailTreasury :: Era era => Term era Coin
mirAvailTreasury :: forall era. Era era => Term era Coin
mirAvailTreasury = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"mirAvailTreasury" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

-- | The Coin availabe for a MIR transfer to/from the Reserves
--   Computed from 'reserves' + 'deltaReserves' - sum('instanReserves')
mirAvailReserves :: Era era => Term era Coin
mirAvailReserves :: forall era. Era era => Term era Coin
mirAvailReserves = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"mirAvailReserves" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

-- EpochState

snapshots :: Era era => Term era (SnapShots (EraCrypto era))
snapshots :: forall era. Era era => Term era (SnapShots (EraCrypto era))
snapshots = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"snapshots" forall era. Era era => Rep era (SnapShots (EraCrypto era))
SnapShotsR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era (SnapShots (EraCrypto era))
snapshotsL))

snapshotsL :: NELens era (SnapShots (EraCrypto era))
snapshotsL :: forall era. NELens era (SnapShots (EraCrypto era))
snapshotsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL

-- | Lens' from the Core PParams to the Model PParamsF which embeds a (Proof era)
ppFL :: Proof era -> Lens' (PParams era) (PParamsF era)
ppFL :: forall era. Proof era -> Lens' (PParams era) (PParamsF era)
ppFL Proof era
p = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\PParams era
pp -> forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p PParams era
pp) (\PParams era
_ (PParamsF Proof era
_ PParams era
qq) -> PParams era
qq)

pparamsVar :: Gov.EraGov era => Proof era -> V era (PParamsF era)
pparamsVar :: forall era. EraGov era => Proof era -> V era (PParamsF era)
pparamsVar Proof era
p = (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"pparams" (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
ppFL Proof era
p)))

pparams :: Gov.EraGov era => Proof era -> Term era (PParamsF era)
pparams :: forall era. EraGov era => Proof era -> Term era (PParamsF era)
pparams Proof era
p = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era. EraGov era => Proof era -> V era (PParamsF era)
pparamsVar Proof era
p

nmLikelihoodsT :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) [Float])
nmLikelihoodsT :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) [Float])
nmLikelihoodsT =
  forall era t. V era t -> Term era t
Var
    ( forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V
        String
"likelihoodsNM"
        (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR (forall era t. Rep era t -> Rep era [t]
ListR forall era. Rep era Float
FloatR))
        (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (NonMyopic (EraCrypto era))
esNonMyopicL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (NonMyopic c) (Map (KeyHash 'StakePool c) [Float])
nmLikelihoodsL))
    )

nmRewardPotT :: Era era => Term era Coin
nmRewardPotT :: forall era. Era era => Term era Coin
nmRewardPotT = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"rewardPotNM" forall era. Rep era Coin
CoinR (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR (forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (NonMyopic (EraCrypto era))
esNonMyopicL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (NonMyopic c) Coin
nmRewardPotL))

-- ===== SnapShots

-- | Helper lens that deals with the Stake newtype, and the shift from Map to VMap
stakeL :: Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL :: forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Stake c -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
unStake)
    (\Stake c
_ Map (Credential 'Staking c) Coin
u -> forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
Stake forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError forall a b. (a -> b) -> a -> b
$ Map (Credential 'Staking c) Coin
u)

-- | Helper lens that deals with the shift from Map to VMap
vmapL :: Lens' (VMap.VMap VMap.VB VMap.VB k v) (Map k v)
vmapL :: forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (\VMap VB VB k v
_ Map k v
u -> forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map k v
u)

markStakeL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
markStakeL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
markStakeL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeMarkL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShot c) (Stake c)
ssStakeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL

markStake :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
markStake :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
markStake = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"markStake" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
markStakeL))

markDelegs ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
markDelegs :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
markDelegs = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"markDelegs" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
markDelegsL))

markDelegsL ::
  NELens era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
markDelegsL :: forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
markDelegsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeMarkL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (SnapShot c)
  (VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c))
ssDelegationsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL

markPools ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
markPools :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
markPools = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"markPools" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Era era => Rep era (PoolParams (EraCrypto era))
PoolParamsR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
markPoolsL))

markPoolsL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
markPoolsL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
markPoolsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeMarkL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (SnapShot c) (VMap VB VB (KeyHash 'StakePool c) (PoolParams c))
ssPoolParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL

markSnapShotT ::
  forall era. Era era => RootTarget era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
markSnapShotT :: forall era.
Era era =>
RootTarget
  era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
markSnapShotT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"SnapShot" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(SnapShot (EraCrypto era))) forall {c}.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
snapfun
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
markStake (forall c. Lens' (SnapShot c) (Stake c)
ssStakeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
markDelegs (forall c.
Lens'
  (SnapShot c)
  (VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c))
ssDelegationsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
markPools (forall c.
Lens'
  (SnapShot c) (VMap VB VB (KeyHash 'StakePool c) (PoolParams c))
ssPoolParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL)
  where
    snapfun :: Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
snapfun Map (Credential 'Staking c) Coin
x Map (Credential 'Staking c) (KeyHash 'StakePool c)
y Map (KeyHash 'StakePool c) (PoolParams c)
z =
      forall c.
Stake c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
-> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
SnapShot
        (forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
Stake (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking c) Coin
x)))
        (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (Credential 'Staking c) (KeyHash 'StakePool c)
y)
        (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (KeyHash 'StakePool c) (PoolParams c)
z)

setStake :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
setStake :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
setStake = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"setStake" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
setStakeL))

setStakeL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
setStakeL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
setStakeL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeSetL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShot c) (Stake c)
ssStakeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL

setDelegs ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
setDelegs :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
setDelegs = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"setDelegs" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
setDelegsL))

setDelegsL ::
  NELens era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
setDelegsL :: forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
setDelegsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeSetL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (SnapShot c)
  (VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c))
ssDelegationsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL

setPools ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
setPools :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
setPools = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"setPools" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Era era => Rep era (PoolParams (EraCrypto era))
PoolParamsR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
setPoolsL))

setPoolsL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
setPoolsL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
setPoolsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeSetL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (SnapShot c) (VMap VB VB (KeyHash 'StakePool c) (PoolParams c))
ssPoolParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL

setSnapShotT ::
  forall era. Era era => RootTarget era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
setSnapShotT :: forall era.
Era era =>
RootTarget
  era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
setSnapShotT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"SnapShot" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(SnapShot (EraCrypto era))) forall {c}.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
snapfun
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
setStake (forall c. Lens' (SnapShot c) (Stake c)
ssStakeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
setDelegs (forall c.
Lens'
  (SnapShot c)
  (VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c))
ssDelegationsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
setPools (forall c.
Lens'
  (SnapShot c) (VMap VB VB (KeyHash 'StakePool c) (PoolParams c))
ssPoolParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL)
  where
    snapfun :: Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
snapfun Map (Credential 'Staking c) Coin
x Map (Credential 'Staking c) (KeyHash 'StakePool c)
y Map (KeyHash 'StakePool c) (PoolParams c)
z =
      forall c.
Stake c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
-> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
SnapShot
        (forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
Stake (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking c) Coin
x)))
        (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (Credential 'Staking c) (KeyHash 'StakePool c)
y)
        (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (KeyHash 'StakePool c) (PoolParams c)
z)

goStake :: Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
goStake :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
goStake = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"goStake" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Rep era Coin
CoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
goStakeL))

goStakeL :: NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
goStakeL :: forall era.
NELens era (Map (Credential 'Staking (EraCrypto era)) Coin)
goStakeL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeGoL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShot c) (Stake c)
ssStakeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL

goDelegs ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
goDelegs :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
goDelegs = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"goDelegs" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
goDelegsL))

goDelegsL ::
  NELens era (Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)))
goDelegsL :: forall era.
NELens
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
goDelegsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeGoL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (SnapShot c)
  (VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c))
ssDelegationsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL

goPools ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
goPools :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
goPools = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"goPools" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era. Era era => Rep era (PoolParams (EraCrypto era))
PoolParamsR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
goPoolsL))

goPoolsL :: NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
goPoolsL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
goPoolsL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeGoL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (SnapShot c) (VMap VB VB (KeyHash 'StakePool c) (PoolParams c))
ssPoolParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL

goSnapShotT ::
  forall era. Era era => RootTarget era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
goSnapShotT :: forall era.
Era era =>
RootTarget
  era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
goSnapShotT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"SnapShot" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(SnapShot (EraCrypto era))) forall {c}.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
snapfun
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
goStake (forall c. Lens' (SnapShot c) (Stake c)
ssStakeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (Stake c) (Map (Credential 'Staking c) Coin)
stakeL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era)))
goDelegs (forall c.
Lens'
  (SnapShot c)
  (VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c))
ssDelegationsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
goPools (forall c.
Lens'
  (SnapShot c) (VMap VB VB (KeyHash 'StakePool c) (PoolParams c))
ssPoolParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k v. Lens' (VMap VB VB k v) (Map k v)
vmapL)
  where
    snapfun :: Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
snapfun Map (Credential 'Staking c) Coin
x Map (Credential 'Staking c) (KeyHash 'StakePool c)
y Map (KeyHash 'StakePool c) (PoolParams c)
z =
      forall c.
Stake c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
-> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
-> SnapShot c
SnapShot
        (forall c.
VMap VB VP (Credential 'Staking c) (CompactForm Coin) -> Stake c
Stake (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking c) Coin
x)))
        (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (Credential 'Staking c) (KeyHash 'StakePool c)
y)
        (forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap Map (KeyHash 'StakePool c) (PoolParams c)
z)

markPoolDistr ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
markPoolDistr :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
markPoolDistr = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"markPoolDistr" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR forall era.
Era era =>
Rep era (IndividualPoolStake (EraCrypto era))
IPoolStakeR) forall era s t. Access era s t
No)

markPoolDistrL ::
  NELens era (Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
markPoolDistrL :: forall era.
NELens
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
markPoolDistrL = forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c. Lens' (SnapShots c) (PoolDistr c)
ssStakeMarkPoolDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (PoolDistr c) (Map (KeyHash 'StakePool c) (IndividualPoolStake c))
poolDistrDistrL

snapShotFee :: Era era => Term era Coin
snapShotFee :: forall era. Era era => Term era Coin
snapShotFee = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"snapShotFee" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

snapShotsT ::
  forall era. Era era => RootTarget era (SnapShots (EraCrypto era)) (SnapShots (EraCrypto era))
snapShotsT :: forall era.
Era era =>
RootTarget
  era (SnapShots (EraCrypto era)) (SnapShots (EraCrypto era))
snapShotsT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"SnapShots" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(SnapShots (EraCrypto era))) forall {c}.
SnapShot c
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> SnapShot c
-> SnapShot c
-> Coin
-> SnapShots c
shotsfun
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift forall era.
Era era =>
RootTarget
  era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
markSnapShotT forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeMarkL
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
markPoolDistr (forall c. Lens' (SnapShots c) (PoolDistr c)
ssStakeMarkPoolDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (PoolDistr c) (Map (KeyHash 'StakePool c) (IndividualPoolStake c))
poolDistrDistrL)
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift forall era.
Era era =>
RootTarget
  era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
setSnapShotT forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeSetL
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t a root1.
RootTarget era t a -> Lens' root1 t -> RootTarget era root1 a
Shift forall era.
Era era =>
RootTarget
  era (SnapShot (EraCrypto era)) (SnapShot (EraCrypto era))
goSnapShotT forall c. Lens' (SnapShots c) (SnapShot c)
ssStakeGoL
    forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ forall era t root.
Term era t -> SimpleGetter root t -> RootTarget era root t
Lensed forall era. Era era => Term era Coin
snapShotFee forall c. Lens' (SnapShots c) Coin
ssFeeL
  where
    shotsfun :: SnapShot c
-> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> SnapShot c
-> SnapShot c
-> Coin
-> SnapShots c
shotsfun SnapShot c
w Map (KeyHash 'StakePool c) (IndividualPoolStake c)
x = forall c.
SnapShot c
-> PoolDistr c -> SnapShot c -> SnapShot c -> Coin -> SnapShots c
SnapShots SnapShot c
w (forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr Map (KeyHash 'StakePool c) (IndividualPoolStake c)
x forall a b. (a -> b) -> a -> b
$ Word64 -> CompactForm Coin
CompactCoin Word64
1)

-- ==================================================================
-- RewardUpdate

deltaT :: Era era => Term era (Maybe DeltaCoin)
deltaT :: forall era. Era era => Term era (Maybe DeltaCoin)
deltaT = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"deltaT" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Rep era DeltaCoin
DeltaCoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era (Maybe DeltaCoin)
deltaTL))

deltaTL :: NELens era (Maybe DeltaCoin)
deltaTL :: forall era. NELens era (Maybe DeltaCoin)
deltaTL = forall era.
Lens'
  (NewEpochState era)
  (StrictMaybe (PulsingRewUpdate (EraCrypto era)))
nesRuL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
help
  where
    help :: Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
    help :: forall c.
Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
help = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {c}. StrictMaybe (PulsingRewUpdate c) -> Maybe DeltaCoin
view forall {c}.
StrictMaybe (PulsingRewUpdate c)
-> Maybe DeltaCoin -> StrictMaybe (PulsingRewUpdate c)
update
      where
        view :: StrictMaybe (PulsingRewUpdate c) -> Maybe DeltaCoin
view StrictMaybe (PulsingRewUpdate c)
SNothing = forall a. Maybe a
Nothing
        view (SJust (Complete RewardUpdate c
x)) = forall a. a -> Maybe a
Just (forall c. RewardUpdate c -> DeltaCoin
RU.deltaT RewardUpdate c
x)
        view (SJust PulsingRewUpdate c
_) = forall a. Maybe a
Nothing
        update :: StrictMaybe (PulsingRewUpdate c)
-> Maybe DeltaCoin -> StrictMaybe (PulsingRewUpdate c)
update (SJust (Complete RewardUpdate c
ru)) (Just DeltaCoin
change) = forall a. a -> StrictMaybe a
SJust (forall c. RewardUpdate c -> PulsingRewUpdate c
Complete (RewardUpdate c
ru {deltaT :: DeltaCoin
RU.deltaT = DeltaCoin
change}))
        update StrictMaybe (PulsingRewUpdate c)
_ Maybe DeltaCoin
_ = forall a. StrictMaybe a
SNothing

deltaR :: Era era => Term era (Maybe DeltaCoin)
deltaR :: forall era. Era era => Term era (Maybe DeltaCoin)
deltaR = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"deltaR" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Rep era DeltaCoin
DeltaCoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era (Maybe DeltaCoin)
deltaRL))

deltaRL :: NELens era (Maybe DeltaCoin)
deltaRL :: forall era. NELens era (Maybe DeltaCoin)
deltaRL = forall era.
Lens'
  (NewEpochState era)
  (StrictMaybe (PulsingRewUpdate (EraCrypto era)))
nesRuL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
help
  where
    help :: Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
    help :: forall c.
Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
help = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {c}. StrictMaybe (PulsingRewUpdate c) -> Maybe DeltaCoin
view forall {c}.
StrictMaybe (PulsingRewUpdate c)
-> Maybe DeltaCoin -> StrictMaybe (PulsingRewUpdate c)
update
      where
        view :: StrictMaybe (PulsingRewUpdate c) -> Maybe DeltaCoin
view StrictMaybe (PulsingRewUpdate c)
SNothing = forall a. Maybe a
Nothing
        view (SJust (Complete RewardUpdate c
x)) = forall a. a -> Maybe a
Just (forall c. RewardUpdate c -> DeltaCoin
RU.deltaR RewardUpdate c
x)
        view (SJust PulsingRewUpdate c
_) = forall a. Maybe a
Nothing
        update :: StrictMaybe (PulsingRewUpdate c)
-> Maybe DeltaCoin -> StrictMaybe (PulsingRewUpdate c)
update (SJust (Complete RewardUpdate c
ru)) (Just DeltaCoin
change) = forall a. a -> StrictMaybe a
SJust (forall c. RewardUpdate c -> PulsingRewUpdate c
Complete (RewardUpdate c
ru {deltaR :: DeltaCoin
RU.deltaR = DeltaCoin
change}))
        update StrictMaybe (PulsingRewUpdate c)
_ Maybe DeltaCoin
_ = forall a. StrictMaybe a
SNothing

deltaF :: Era era => Term era (Maybe DeltaCoin)
deltaF :: forall era. Era era => Term era (Maybe DeltaCoin)
deltaF = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"deltaF" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Rep era DeltaCoin
DeltaCoinR) (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes forall era. Era era => Rep era (NewEpochState era)
NewEpochStateR forall era. NELens era (Maybe DeltaCoin)
deltaFL))

deltaFL :: NELens era (Maybe DeltaCoin)
deltaFL :: forall era. NELens era (Maybe DeltaCoin)
deltaFL = forall era.
Lens'
  (NewEpochState era)
  (StrictMaybe (PulsingRewUpdate (EraCrypto era)))
nesRuL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
help
  where
    help :: Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
    help :: forall c.
Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe DeltaCoin)
help = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {c}. StrictMaybe (PulsingRewUpdate c) -> Maybe DeltaCoin
view forall {c}.
StrictMaybe (PulsingRewUpdate c)
-> Maybe DeltaCoin -> StrictMaybe (PulsingRewUpdate c)
update
      where
        view :: StrictMaybe (PulsingRewUpdate c) -> Maybe DeltaCoin
view StrictMaybe (PulsingRewUpdate c)
SNothing = forall a. Maybe a
Nothing
        view (SJust (Complete RewardUpdate c
x)) = forall a. a -> Maybe a
Just (forall c. RewardUpdate c -> DeltaCoin
RU.deltaF RewardUpdate c
x)
        view (SJust PulsingRewUpdate c
_) = forall a. Maybe a
Nothing
        update :: StrictMaybe (PulsingRewUpdate c)
-> Maybe DeltaCoin -> StrictMaybe (PulsingRewUpdate c)
update (SJust (Complete RewardUpdate c
ru)) (Just DeltaCoin
change) = forall a. a -> StrictMaybe a
SJust (forall c. RewardUpdate c -> PulsingRewUpdate c
Complete (RewardUpdate c
ru {deltaF :: DeltaCoin
RU.deltaF = DeltaCoin
change}))
        update StrictMaybe (PulsingRewUpdate c)
_ Maybe DeltaCoin
_ = forall a. StrictMaybe a
SNothing

rewardSet ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (Set (Reward (EraCrypto era))))
rewardSet :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'Staking (EraCrypto era))
     (Set (Reward (EraCrypto era))))
rewardSet = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"rewardSet" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (Reward (EraCrypto era))
RewardR)) forall era s t. Access era s t
No)

rewardSetL ::
  NELens era (Maybe (Map (Credential 'Staking (EraCrypto era)) (Set (Reward (EraCrypto era)))))
rewardSetL :: forall era.
NELens
  era
  (Maybe
     (Map
        (Credential 'Staking (EraCrypto era))
        (Set (Reward (EraCrypto era)))))
rewardSetL = forall era.
Lens'
  (NewEpochState era)
  (StrictMaybe (PulsingRewUpdate (EraCrypto era)))
nesRuL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall c.
Lens'
  (StrictMaybe (PulsingRewUpdate c))
  (Maybe (Map (Credential 'Staking c) (Set (Reward c))))
help
  where
    help ::
      Lens' (StrictMaybe (PulsingRewUpdate c)) (Maybe (Map (Credential 'Staking c) (Set (Reward c))))
    help :: forall c.
Lens'
  (StrictMaybe (PulsingRewUpdate c))
  (Maybe (Map (Credential 'Staking c) (Set (Reward c))))
help = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {c}.
StrictMaybe (PulsingRewUpdate c)
-> Maybe (Map (Credential 'Staking c) (Set (Reward c)))
view forall {c}.
StrictMaybe (PulsingRewUpdate c)
-> Maybe (Map (Credential 'Staking c) (Set (Reward c)))
-> StrictMaybe (PulsingRewUpdate c)
update
      where
        view :: StrictMaybe (PulsingRewUpdate c)
-> Maybe (Map (Credential 'Staking c) (Set (Reward c)))
view StrictMaybe (PulsingRewUpdate c)
SNothing = forall a. Maybe a
Nothing
        view (SJust (Complete RewardUpdate c
x)) = forall a. a -> Maybe a
Just (forall c.
RewardUpdate c -> Map (Credential 'Staking c) (Set (Reward c))
RU.rs RewardUpdate c
x)
        view (SJust PulsingRewUpdate c
_) = forall a. Maybe a
Nothing
        update :: StrictMaybe (PulsingRewUpdate c)
-> Maybe (Map (Credential 'Staking c) (Set (Reward c)))
-> StrictMaybe (PulsingRewUpdate c)
update (SJust (Complete RewardUpdate c
ru)) (Just Map (Credential 'Staking c) (Set (Reward c))
change) = forall a. a -> StrictMaybe a
SJust (forall c. RewardUpdate c -> PulsingRewUpdate c
Complete (RewardUpdate c
ru {rs :: Map (Credential 'Staking c) (Set (Reward c))
RU.rs = Map (Credential 'Staking c) (Set (Reward c))
change}))
        update StrictMaybe (PulsingRewUpdate c)
_ Maybe (Map (Credential 'Staking c) (Set (Reward c)))
_ = forall a. StrictMaybe a
SNothing

-- ===================================================================
-- Non Access variables

totalAda :: Era era => Term era Coin
totalAda :: forall era. Era era => Term era Coin
totalAda = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"totalAda" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

utxoCoin :: Era era => Term era Coin
utxoCoin :: forall era. Era era => Term era Coin
utxoCoin = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"utxoCoin" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

-- | The universe of Staking Credentials. A credential is either KeyHash of a ScriptHash
--   Any Plutus scripts in this Universe are NOT Spending scripts, so they do not need a Redeemer
credsUniv :: Era era => Term era (Set (Credential 'Staking (EraCrypto era)))
credsUniv :: forall era.
Era era =>
Term era (Set (Credential 'Staking (EraCrypto era)))
credsUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"credsUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'Staking (EraCrypto era))
CredR) forall era s t. Access era s t
No

-- | The universe of Staking Credentials. A credential is either KeyHash of a ScriptHash
--   All Plutus scripts in this Universe are SPENDING scripts, so they will need a Redeemer
--   Use this ONLY in the Pay-part of an Address (Do not use this in the Stake-part of an Address)
spendCredsUniv :: Era era => Term era (Set (Credential 'Payment (EraCrypto era)))
spendCredsUniv :: forall era.
Era era =>
Term era (Set (Credential 'Payment (EraCrypto era)))
spendCredsUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"spendCredsUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'Payment (EraCrypto era))
PCredR) forall era s t. Access era s t
No

-- | The universe of Voting Credentials. A credential is either KeyHash of a ScriptHash
voteUniv :: Era era => Term era (Set (Credential 'DRepRole (EraCrypto era)))
voteUniv :: forall era.
Era era =>
Term era (Set (Credential 'DRepRole (EraCrypto era)))
voteUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"voteUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'DRepRole (EraCrypto era))
VCredR) forall era s t. Access era s t
No

-- | The universe of DReps
drepUniv :: Era era => Term era (Set (DRep (EraCrypto era)))
drepUniv :: forall era. Era era => Term era (Set (DRep (EraCrypto era)))
drepUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"drepUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (DRep (EraCrypto era))
DRepR) forall era s t. Access era s t
No

-- | The universe of Credentials used in voting for constitutional committee changes.
hotCommitteeCredsUniv :: Era era => Term era (Set (Credential 'HotCommitteeRole (EraCrypto era)))
hotCommitteeCredsUniv :: forall era.
Era era =>
Term era (Set (Credential 'HotCommitteeRole (EraCrypto era)))
hotCommitteeCredsUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"hotCommitteeCredsUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'HotCommitteeRole (EraCrypto era))
CommHotCredR) forall era s t. Access era s t
No

-- | The universe of Credentials used in voting for constitutional committee changes.
coldCommitteeCredsUniv :: Era era => Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
coldCommitteeCredsUniv :: forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
coldCommitteeCredsUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"coldCommitteeCredsUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'ColdCommitteeRole (EraCrypto era))
CommColdCredR) forall era s t. Access era s t
No

-- | The universe of Payment Credentials. A credential is either KeyHash of a ScriptHash
--   We only find payment credentials in the Payment part of an Addr.
payUniv :: Era era => Term era (Set (Credential 'Payment (EraCrypto era)))
payUniv :: forall era.
Era era =>
Term era (Set (Credential 'Payment (EraCrypto era)))
payUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"payUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'Payment (EraCrypto era))
PCredR) forall era s t. Access era s t
No

-- | The universe of Scripts (and their hashes) useable in spending contexts
--  That means if they are Plutus scripts then they will be passed an additional
--  argument (the TxInfo context)
spendscriptUniv :: Era era => Proof era -> Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
spendscriptUniv :: forall era.
Era era =>
Proof era
-> Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
spendscriptUniv Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"spendscriptUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (ScriptHash (EraCrypto era))
ScriptHashR (forall era. Era era => Proof era -> Rep era (ScriptF era)
ScriptR Proof era
p)) forall era s t. Access era s t
No)

-- | The universe of Scripts (and their hashes) useable in contexts other than Spending
nonSpendScriptUniv ::
  Era era => Proof era -> Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
nonSpendScriptUniv :: forall era.
Era era =>
Proof era
-> Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
nonSpendScriptUniv Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"nonSpendScriptUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (ScriptHash (EraCrypto era))
ScriptHashR (forall era. Era era => Proof era -> Rep era (ScriptF era)
ScriptR Proof era
p)) forall era s t. Access era s t
No)

-- | The union of 'spendscriptUniv' and 'nonSpendScriptUniv'. All possible scripts in any context
allScriptUniv :: Era era => Proof era -> Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
allScriptUniv :: forall era.
Era era =>
Proof era
-> Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
allScriptUniv Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"allScriptUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (ScriptHash (EraCrypto era))
ScriptHashR (forall era. Era era => Proof era -> Rep era (ScriptF era)
ScriptR Proof era
p)) forall era s t. Access era s t
No)

-- | The universe of Data (and their hashes)
dataUniv :: Era era => Term era (Map (DataHash (EraCrypto era)) (Data era))
dataUniv :: forall era.
Era era =>
Term era (Map (DataHash (EraCrypto era)) (Data era))
dataUniv = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"dataUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (DataHash (EraCrypto era))
DataHashR forall era. Era era => Rep era (Data era)
DataR) forall era s t. Access era s t
No)

-- | The universe of StakePool key hashes. These hashes hash the cold key of the
--   Pool operators.
poolHashUniv :: Era era => Term era (Set (KeyHash 'StakePool (EraCrypto era)))
poolHashUniv :: forall era.
Era era =>
Term era (Set (KeyHash 'StakePool (EraCrypto era)))
poolHashUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"poolHashUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (KeyHash 'StakePool (EraCrypto era))
PoolHashR) forall era s t. Access era s t
No

-- | The universe of StakePool key hashes. These hashes hash are hashes of the Owners of a PoolParam
stakeHashUniv :: Era era => Term era (Set (KeyHash 'Staking (EraCrypto era)))
stakeHashUniv :: forall era.
Era era =>
Term era (Set (KeyHash 'Staking (EraCrypto era)))
stakeHashUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"stakeHashUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (KeyHash 'Staking (EraCrypto era))
StakeHashR) forall era s t. Access era s t
No

-- | The universe of DRep key hashes. These hashes hash are hashes of the DReps
drepHashUniv :: Era era => Term era (Set (KeyHash 'DRepRole (EraCrypto era)))
drepHashUniv :: forall era.
Era era =>
Term era (Set (KeyHash 'DRepRole (EraCrypto era)))
drepHashUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"drepHashUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (KeyHash 'DRepRole (EraCrypto era))
DRepHashR) forall era s t. Access era s t
No

-- | The universe of the Genesis key hashes and their signing and validating GenDelegPairs
genesisHashUniv ::
  Era era => Term era (Map (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genesisHashUniv :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genesisHashUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"genesisHashUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'Genesis (EraCrypto era))
GenHashR forall era. Era era => Rep era (GenDelegPair (EraCrypto era))
GenDelegPairR) forall era s t. Access era s t
No

voteCredUniv :: Era era => Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
voteCredUniv :: forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
voteCredUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"voteHashUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era.
Era era =>
Rep era (Credential 'ColdCommitteeRole (EraCrypto era))
CommColdCredR) forall era s t. Access era s t
No

-- | The universe of TxIns. Pairs of TxId: hashes of previously run transaction bodies,
--   and TxIx: indexes of one of the bodies outputs.
txinUniv :: Era era => Term era (Set (TxIn (EraCrypto era)))
txinUniv :: forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
txinUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"txinUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (TxIn (EraCrypto era))
TxInR) forall era s t. Access era s t
No

-- | The universe of GovActionId. Pairs of TxId: hashes of previously run transaction bodies,
--   and GovActionIx: indexes of one of the bodies Proposals .
govActionIdUniv :: Era era => Term era (Set (GovActionId (EraCrypto era)))
govActionIdUniv :: forall era. Era era => Term era (Set (GovActionId (EraCrypto era)))
govActionIdUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"govActionIdUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR) forall era s t. Access era s t
No

-- | The universe of TxOuts.
--   It contains 'colTxoutUniv' as a sublist and 'feeOutput' as an element
--   See also 'feeOutput' which is defined by the universes, and is related.
txoutUniv :: Era era => Proof era -> Term era (Set (TxOutF era))
txoutUniv :: forall era. Era era => Proof era -> Term era (Set (TxOutF era))
txoutUniv Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"txoutUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof era
p)) forall era s t. Access era s t
No)

-- | The universe of TxOuts useable for collateral
--   The collateral TxOuts consists only of VKey addresses
--   and The collateral TxOuts do not contain any non-ADA part
colTxoutUniv :: Era era => Proof era -> Term era (Set (TxOutF era))
colTxoutUniv :: forall era. Era era => Proof era -> Term era (Set (TxOutF era))
colTxoutUniv Proof era
p = forall era t. V era t -> Term era t
Var (forall era t s.
Proof era -> String -> Rep era t -> Access era s t -> V era t
pV Proof era
p String
"colTxoutUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof era
p)) forall era s t. Access era s t
No)

-- | A TxOut, guaranteed to have
--   1) no scripts in its Addr, and
--   2) It's Addr is in the addrUniv
--   3) 'bigCoin' is stored in the Addr Value, and
--   4) the Addr Value has empty MutiAssets
--   5) be a member of the txoutUniv
feeTxOut :: Reflect era => Term era (TxOutF era)
feeTxOut :: forall era. Reflect era => Term era (TxOutF era)
feeTxOut = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"feeTxOut" (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No)

-- | A TxIn, guaranteed to have
--  1) be a member of the txinUniv
feeTxIn :: Era era => Term era (TxIn (EraCrypto era))
feeTxIn :: forall era. Era era => Term era (TxIn (EraCrypto era))
feeTxIn = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"feeTxIn" forall era. Era era => Rep era (TxIn (EraCrypto era))
TxInR forall era s t. Access era s t
No)

-- | A Coin large enough to pay almost any fee.
--   See also 'feeOutput' which is related.
bigCoin :: Era era => Term era Coin
bigCoin :: forall era. Era era => Term era Coin
bigCoin = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"bigCoin" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

datumsUniv :: Era era => Term era [Datum era]
datumsUniv :: forall era. Era era => Term era [Datum era]
datumsUniv = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"datumsUniv" (forall era t. Rep era t -> Rep era [t]
ListR forall era. Era era => Rep era (Datum era)
DatumR) forall era s t. Access era s t
No)

multiAssetUniv :: Era era => Term era [MultiAsset (EraCrypto era)]
multiAssetUniv :: forall era. Era era => Term era [MultiAsset (EraCrypto era)]
multiAssetUniv = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"multiAssetUniv" (forall era t. Rep era t -> Rep era [t]
ListR forall era. Era era => Rep era (MultiAsset (EraCrypto era))
MultiAssetR) forall era s t. Access era s t
No)

-- | The universe of key hashes, and the signing and validating key pairs they represent.
keymapUniv ::
  Era era => Term era (Map (KeyHash 'Witness (EraCrypto era)) (KeyPair 'Witness (EraCrypto era)))
keymapUniv :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'Witness (EraCrypto era))
     (KeyPair 'Witness (EraCrypto era)))
keymapUniv = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"keymapUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'Witness (EraCrypto era))
WitHashR forall era. Era era => Rep era (KeyPair 'Witness (EraCrypto era))
KeyPairR) forall era s t. Access era s t
No)

currentSlot :: Era era => Term era SlotNo
currentSlot :: forall era. Era era => Term era SlotNo
currentSlot = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"currentSlot" forall era. Rep era SlotNo
SlotNoR forall era s t. Access era s t
No)

endSlotDelta :: Era era => Term era SlotNo
endSlotDelta :: forall era. Era era => Term era SlotNo
endSlotDelta = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"endSlotDelta" forall era. Rep era SlotNo
SlotNoR forall era s t. Access era s t
No)

beginSlotDelta :: Era era => Term era SlotNo
beginSlotDelta :: forall era. Era era => Term era SlotNo
beginSlotDelta = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"beginSlotDelta" forall era. Rep era SlotNo
SlotNoR forall era s t. Access era s t
No)

-- See also currentEpoch in NewEpochState fields

-- | From Globals
network :: Era era => Term era Network
network :: forall era. Era era => Term era Network
network = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"network" forall era. Rep era Network
NetworkR forall era s t. Access era s t
No)

-- | This not really a variable, But a constant that is set by the 'testGlobals'
--   we reflect this into a Term, so we can refer to it in the Preds.
quorumConstant :: Word64
quorumConstant :: Word64
quorumConstant = Globals -> Word64
Base.quorum Globals
Utils.testGlobals

-- | From Globals. Reflected here at type Int, This is set to 'quorumConstant' in CertState.
--   because is is used to compare the Size of things, which are computed as Int
quorum :: Era era => Term era Int
quorum :: forall era. Era era => Term era Int
quorum = forall era t. V era t -> Term era t
Var (forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"quorum" forall era. Rep era Int
IntR forall era s t. Access era s t
No)

addrUniv :: Era era => Term era (Set (Addr (EraCrypto era)))
addrUniv :: forall era. Era era => Term era (Set (Addr (EraCrypto era)))
addrUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"addrUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (Addr (EraCrypto era))
AddrR) forall era s t. Access era s t
No

ptrUniv :: Era era => Term era (Set Ptr)
ptrUniv :: forall era. Era era => Term era (Set Ptr)
ptrUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"ptrUniv" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Rep era Ptr
PtrR) forall era s t. Access era s t
No

plutusUniv :: Reflect era => Term era (Map (ScriptHash (EraCrypto era)) (IsValid, ScriptF era))
plutusUniv :: forall era.
Reflect era =>
Term era (Map (ScriptHash (EraCrypto era)) (IsValid, ScriptF era))
plutusUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"plutusUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (ScriptHash (EraCrypto era))
ScriptHashR (forall era t r. Rep era t -> Rep era r -> Rep era (t, r)
PairR forall era. Rep era IsValid
IsValidR (forall era. Era era => Proof era -> Rep era (ScriptF era)
ScriptR forall era. Reflect era => Proof era
reify))) forall era s t. Access era s t
No

spendPlutusUniv :: Reflect era => Term era (Map (ScriptHash (EraCrypto era)) (IsValid, ScriptF era))
spendPlutusUniv :: forall era.
Reflect era =>
Term era (Map (ScriptHash (EraCrypto era)) (IsValid, ScriptF era))
spendPlutusUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"spendPlutusUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (ScriptHash (EraCrypto era))
ScriptHashR (forall era t r. Rep era t -> Rep era r -> Rep era (t, r)
PairR forall era. Rep era IsValid
IsValidR (forall era. Era era => Proof era -> Rep era (ScriptF era)
ScriptR forall era. Reflect era => Proof era
reify))) forall era s t. Access era s t
No

-- | The universe of all Byron addresses. In Eras, Babbage, Conway we avoid these Adresses,
--   as they do not play well with Plutus Scripts.
byronAddrUniv ::
  Era era => Term era (Map (KeyHash 'Payment (EraCrypto era)) (Addr (EraCrypto era), SigningKey))
byronAddrUniv :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'Payment (EraCrypto era))
     (Addr (EraCrypto era), SigningKey))
byronAddrUniv = forall era t. V era t -> Term era t
Var forall a b. (a -> b) -> a -> b
$ forall era t s.
Era era =>
String -> Rep era t -> Access era s t -> V era t
V String
"byronAddrUniv" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (KeyHash 'Payment (EraCrypto era))
PayHashR (forall era t r. Rep era t -> Rep era r -> Rep era (t, r)
PairR forall era. Era era => Rep era (Addr (EraCrypto era))
AddrR forall era. Rep era SigningKey
SigningKeyR)) forall era s t. Access era s t
No

-- ====================================================================
-- Targets for sub types of NewEpochState
-- A Target assembles variables into data stuctures. The main concern
-- is transforming the types used in the variable model into the real types
-- stored in the data structures. 4 examples of such transformation
-- 1) Wrapping and unwraping newtypes like StakeDistr
-- 2) Transforming Coin into (CompactForm Coin) a Word64
-- 3) Transforming Data.Map into Data.VMap
-- 4) Transforming the Models view of Data Families (TxOut, Value, PParams, PParamsUpdate) into
--    the data structures view.
--
-- The strategy we use is to define a "constructor function" which accepts the model types,
-- and which converts the model types into the data structure types. We then wrap this
-- "constructor function" in the "Constr" of Target. See 'newEpochStateConstr',
-- 'utxofun' and 'dstate' for examples of how this is done.

-- | Abstract constuctor function for NewEpochState
newEpochStateConstr ::
  Proof era ->
  EpochNo ->
  Map (KeyHash 'StakePool (EraCrypto era)) Natural ->
  Map (KeyHash 'StakePool (EraCrypto era)) Natural ->
  EpochState era ->
  Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)) ->
  NewEpochState era
newEpochStateConstr :: forall era.
Proof era
-> EpochNo
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
-> Map (KeyHash 'StakePool (EraCrypto era)) Natural
-> EpochState era
-> Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
-> NewEpochState era
newEpochStateConstr
  Proof era
proof
  EpochNo
nesEL'
  Map (KeyHash 'StakePool (EraCrypto era)) Natural
nesBprev'
  Map (KeyHash 'StakePool (EraCrypto era))