{-# 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 (
  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.Era (Era (EraCrypto))
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.Class (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)) Natural
nesBcur'
  EpochState era
nesEs'
  Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
nesPd' =
    forall era.
EpochNo
-> BlocksMade (EraCrypto era)
-> BlocksMade (EraCrypto era)
-> EpochState era
-> StrictMaybe (PulsingRewUpdate (EraCrypto era))
-> PoolDistr (EraCrypto era)
-> StashedAVVMAddresses era
-> NewEpochState era
NewEpochState
      EpochNo
nesEL'
      (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
nesBprev')
      (forall c. Map (KeyHash 'StakePool c) Natural -> BlocksMade c
BlocksMade Map (KeyHash 'StakePool (EraCrypto era)) Natural
nesBcur')
      EpochState era
nesEs'
      forall a. StrictMaybe a
SNothing
      (forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
nesPd' forall a b. (a -> b) -> a -> b
$ Word64 -> CompactForm Coin
CompactCoin Word64
1)
      ( case Proof era
proof of
          Proof era
Shelley -> forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall k a. Map k a
Map.empty
          Proof era
Allegra -> ()
          Proof era
Mary -> ()
          Proof era
Alonzo -> ()
          Proof era
Babbage -> ()
          Proof era
Conway -> ()
      )

-- | Target for NewEpochState
newEpochStateT ::
  forall era. Gov.EraGov era => Proof era -> RootTarget era (NewEpochState era) (NewEpochState era)
newEpochStateT :: forall era.
EraGov era =>
Proof era -> RootTarget era (NewEpochState era) (NewEpochState era)
newEpochStateT Proof era
proof =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"NewEpochState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(NewEpochState era)) (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)
    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 EpochNo
currentEpoch forall era. Lens' (NewEpochState era) EpochNo
nesELL
    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)) Natural)
prevBlocksMade forall era.
Lens'
  (NewEpochState era)
  (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
nesBprevL
    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)) Natural)
currBlocksMade forall era.
Lens'
  (NewEpochState era)
  (Map (KeyHash 'StakePool (EraCrypto era)) Natural)
nesBcurL
    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.
EraGov era =>
Proof era -> RootTarget era (EpochState era) (EpochState era)
epochStateT Proof era
proof) forall era. Lens' (NewEpochState era) (EpochState era)
nesEsL
    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)))
poolDistr (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)

-- | Target for EpochState
epochStateT ::
  forall era. Gov.EraGov era => Proof era -> RootTarget era (EpochState era) (EpochState era)
epochStateT :: forall era.
EraGov era =>
Proof era -> RootTarget era (EpochState era) (EpochState era)
epochStateT Proof era
proof =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"EpochState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(EpochState era)) forall {era}.
AccountState
-> LedgerState era -> SnapShots (EraCrypto era) -> EpochState era
epochStateFun
    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 AccountState AccountState
accountStateT forall era. Lens' (EpochState era) AccountState
esAccountStateL
    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.
EraGov era =>
Proof era -> RootTarget era (LedgerState era) (LedgerState era)
ledgerStateT Proof era
proof) forall era. Lens' (EpochState era) (LedgerState era)
esLStateL
    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 (SnapShots (EraCrypto era)) (SnapShots (EraCrypto era))
snapShotsT forall era. Lens' (EpochState era) (SnapShots (EraCrypto era))
esSnapshotsL
  where
    epochStateFun :: AccountState
-> LedgerState era -> SnapShots (EraCrypto era) -> EpochState era
epochStateFun AccountState
a LedgerState era
s SnapShots (EraCrypto era)
l = forall era.
AccountState
-> LedgerState era
-> SnapShots (EraCrypto era)
-> NonMyopic (EraCrypto era)
-> EpochState era
EpochState AccountState
a LedgerState era
s SnapShots (EraCrypto era)
l (forall c.
Map (KeyHash 'StakePool c) Likelihood -> Coin -> NonMyopic c
NonMyopic forall k a. Map k a
Map.empty (Integer -> Coin
Coin Integer
0))

-- | Target for AccountState
accountStateT :: Era era => RootTarget era AccountState AccountState
accountStateT :: forall era. Era era => RootTarget era AccountState AccountState
accountStateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"AccountState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @AccountState) Coin -> Coin -> AccountState
AccountState
    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
treasury Lens' AccountState Coin
asTreasuryL
    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
reserves Lens' AccountState Coin
asReservesL

-- | Target for LedgerState
ledgerStateT ::
  forall era. Gov.EraGov era => Proof era -> RootTarget era (LedgerState era) (LedgerState era)
ledgerStateT :: forall era.
EraGov era =>
Proof era -> RootTarget era (LedgerState era) (LedgerState era)
ledgerStateT Proof era
proof =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"LedgerState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(LedgerState era)) forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
    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.
EraGov era =>
Proof era -> RootTarget era (UTxOState era) (UTxOState era)
utxoStateT Proof era
proof) forall era. Lens' (LedgerState era) (UTxOState era)
lsUTxOStateL
    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 (CertState era) (CertState era)
certstateT forall era. Lens' (LedgerState era) (CertState era)
lsCertStateL

ledgerState :: Reflect era => Term era (LedgerState era)
ledgerState :: forall era. Reflect era => Term era (LedgerState era)
ledgerState = 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
"ledgerState" (forall era. Era era => Proof era -> Rep era (LedgerState era)
LedgerStateR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No

-- | Target for UTxOState
utxoStateT ::
  forall era. Gov.EraGov era => Proof era -> RootTarget era (UTxOState era) (UTxOState era)
utxoStateT :: forall era.
EraGov era =>
Proof era -> RootTarget era (UTxOState era) (UTxOState era)
utxoStateT Proof era
p =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"UTxOState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(UTxOState era)) (forall era a. (Reflect era => Proof era -> a) -> Proof era -> a
unReflect Reflect era =>
Proof era
-> Map (TxIn (EraCrypto era)) (TxOutF era)
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
utxofun 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 (TxIn (EraCrypto era)) (TxOutF era))
utxo Proof era
p) (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
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 => Term era Coin
deposits forall era. Lens' (UTxOState era) Coin
utxosDepositedL
    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
fees forall era. Lens' (UTxOState era) Coin
utxosFeesL
    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 =>
Proof era -> RootTarget era (GovState era) (GovState era)
govStateT Proof era
p) (forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (GovState era) (GovState era)
unGovL 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 => Term era Coin
donation forall era. Lens' (UTxOState era) Coin
utxosDonationL
  where
    utxofun ::
      Reflect era =>
      Proof era ->
      Map (TxIn (EraCrypto era)) (TxOutF era) ->
      Coin ->
      Coin ->
      GovState era ->
      Coin ->
      UTxOState era
    utxofun :: Reflect era =>
Proof era
-> Map (TxIn (EraCrypto era)) (TxOutF era)
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
utxofun Proof era
proof Map (TxIn (EraCrypto era)) (TxOutF era)
u Coin
c1 Coin
c2 (GovState Proof era
_ GovState era
x) = forall era.
EraTxOut era =>
PParams era
-> UTxO era
-> Coin
-> Coin
-> GovState era
-> Coin
-> UTxOState era
smartUTxOState (forall era. Reflect era => Proof era -> PParams era
justProtocolVersion Proof era
proof) (forall era. Map (TxIn (EraCrypto era)) (TxOutF era) -> UTxO era
liftUTxO Map (TxIn (EraCrypto era)) (TxOutF era)
u) Coin
c1 Coin
c2 GovState era
x

unGovL :: Proof era -> Lens' (Gov.GovState era) (GovState era)
unGovL :: forall era. Proof era -> Lens' (GovState era) (GovState era)
unGovL Proof era
p = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\GovState era
x -> forall era. Proof era -> GovState era -> GovState era
GovState Proof era
p GovState era
x) (\GovState era
_ (GovState Proof era
_ GovState era
y) -> GovState era
y)

justProtocolVersion :: forall era. Reflect era => Proof era -> PParams era
justProtocolVersion :: forall era. Reflect era => Proof era -> PParams era
justProtocolVersion Proof era
proof = forall era.
EraPParams era =>
Proof era -> [PParamsField era] -> PParams era
newPParams Proof era
proof [forall era. ProtVer -> PParamsField era
Fields.ProtocolVersion forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> ProtVer
protocolVersion Proof era
proof]

-- | Target for CertState
certstateT :: forall era. Era era => RootTarget era (CertState era) (CertState era)
certstateT :: forall era.
Era era =>
RootTarget era (CertState era) (CertState era)
certstateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"CertState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(CertState era)) forall era. VState era -> PState era -> DState era -> CertState era
CertState
    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 (VState era) (VState era)
vstateT forall era. Lens' (CertState era) (VState era)
certVStateL)
    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 (PState era) (PState era)
pstateT forall era. Lens' (CertState era) (PState era)
certPStateL)
    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 (DState era) (DState era)
dstateT forall era. Lens' (CertState era) (DState era)
certDStateL)

-- | Target for VState
vstateT :: forall era. Era era => RootTarget era (VState era) (VState era)
vstateT :: forall era. Era era => RootTarget era (VState era) (VState era)
vstateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"VState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(VState era)) (\Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
x Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
y EpochNo
z -> forall era.
Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> CommitteeState era -> EpochNo -> VState era
VState Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
x (forall era.
Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
-> CommitteeState era
CommitteeState Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
y) EpochNo
z)
    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 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
currentDRepState forall era.
Lens'
  (VState era)
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
vsDRepsL
    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 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
committeeState (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)
    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 EpochNo
numDormantEpochs forall era. Lens' (VState era) EpochNo
vsNumDormantEpochsL

committeeL ::
  Lens'
    ( Map
        (Credential 'ColdCommitteeRole (EraCrypto era))
        (CommitteeAuthorization (EraCrypto era))
    )
    (CommitteeState era)
committeeL :: forall era.
Lens'
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
  (CommitteeState era)
committeeL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era.
Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
-> CommitteeState era
CommitteeState (\Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
_ (CommitteeState Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
x) -> Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
x)

-- | Target for PState
pstateT :: forall era. Era era => RootTarget era (PState era) (PState era)
pstateT :: forall era. Era era => RootTarget era (PState era) (PState era)
pstateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"PState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(PState era)) forall era.
Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
-> Map (KeyHash 'StakePool (EraCrypto era)) Coin
-> PState era
PState
    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)))
regPools forall era.
Lens'
  (PState era)
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
psStakePoolParamsL
    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)))
futureRegPools forall era.
Lens'
  (PState era)
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
psFutureStakePoolParamsL
    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)) EpochNo)
retiring forall era.
Lens'
  (PState era) (Map (KeyHash 'StakePool (EraCrypto era)) EpochNo)
psRetiringL
    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)) Coin)
poolDeposits forall era.
Lens' (PState era) (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
psDepositsL

-- | Target for DState
dstateT :: forall era. Era era => RootTarget era (DState era) (DState era)
dstateT :: forall era. Era era => RootTarget era (DState era) (DState era)
dstateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"DState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(DState era)) forall era.
Map (Credential 'Staking (EraCrypto era)) Coin
-> Map (Credential 'Staking (EraCrypto era)) Coin
-> Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
-> Map Ptr (Credential 'Staking (EraCrypto era))
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> Map
     (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> InstantaneousRewards (EraCrypto era)
-> DState era
dstate
    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)
rewards (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)
    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)
stakeDeposits (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)
    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)))
delegations (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)
    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)) (DRep (EraCrypto era)))
drepDelegation (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)
    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 Ptr (Credential 'Staking (EraCrypto era)))
ptrs (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)
    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
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
futureGenDelegs forall era.
Lens'
  (DState era)
  (Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)))
dsFutureGenDelegsL
    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 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)))
genDelegs (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)
    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
  (InstantaneousRewards (EraCrypto era))
  (InstantaneousRewards (EraCrypto era))
instantaneousRewardsT forall era.
Lens' (DState era) (InstantaneousRewards (EraCrypto era))
dsIRewardsL

-- | Abstract construcor function for DState
dstate ::
  Map (Credential 'Staking (EraCrypto era)) Coin ->
  Map (Credential 'Staking (EraCrypto era)) Coin ->
  Map (Credential 'Staking (EraCrypto era)) (KeyHash 'StakePool (EraCrypto era)) ->
  Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)) ->
  Map Ptr (Credential 'Staking (EraCrypto era)) ->
  Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era)) ->
  Map (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)) ->
  InstantaneousRewards (EraCrypto era) ->
  DState era
dstate :: forall era.
Map (Credential 'Staking (EraCrypto era)) Coin
-> Map (Credential 'Staking (EraCrypto era)) Coin
-> Map
     (Credential 'Staking (EraCrypto era))
     (KeyHash 'StakePool (EraCrypto era))
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
-> Map Ptr (Credential 'Staking (EraCrypto era))
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> Map
     (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> InstantaneousRewards (EraCrypto era)
-> DState era
dstate Map (Credential 'Staking (EraCrypto era)) Coin
rew Map (Credential 'Staking (EraCrypto era)) Coin
dep Map
  (Credential 'Staking (EraCrypto era))
  (KeyHash 'StakePool (EraCrypto era))
deleg Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
drepdeleg Map Ptr (Credential 'Staking (EraCrypto era))
ptr Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
fgen Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
gen =
  forall era.
UMap (EraCrypto era)
-> Map
     (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> GenDelegs (EraCrypto era)
-> InstantaneousRewards (EraCrypto era)
-> DState era
DState
    (forall c. Split c -> UMap c
unSplitUMap (forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> Map (Credential 'Staking c) (Set Ptr)
-> Map Ptr (Credential 'Staking c)
-> Split c
Split Map (Credential 'Staking (EraCrypto era)) Coin
rew Map (Credential 'Staking (EraCrypto era)) Coin
dep Map
  (Credential 'Staking (EraCrypto era))
  (KeyHash 'StakePool (EraCrypto era))
deleg Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
drepdeleg (forall a. HasCallStack => String -> a
error String
"Not implemented") Map Ptr (Credential 'Staking (EraCrypto era))
ptr))
    Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
fgen
    (forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs Map
  (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
gen)

instantaneousRewardsT ::
  forall era.
  Era era =>
  RootTarget era (InstantaneousRewards (EraCrypto era)) (InstantaneousRewards (EraCrypto era))
instantaneousRewardsT :: forall era.
Era era =>
RootTarget
  era
  (InstantaneousRewards (EraCrypto era))
  (InstantaneousRewards (EraCrypto era))
instantaneousRewardsT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"InstanRew" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(InstantaneousRewards (EraCrypto era))) forall c.
Map (Credential 'Staking c) Coin
-> Map (Credential 'Staking c) Coin
-> DeltaCoin
-> DeltaCoin
-> InstantaneousRewards c
InstantaneousRewards
    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)
instanReserves forall c.
Lens' (InstantaneousRewards c) (Map (Credential 'Staking c) Coin)
iRReservesL
    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)
instanTreasury forall c.
Lens' (InstantaneousRewards c) (Map (Credential 'Staking c) Coin)
iRTreasuryL
    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 DeltaCoin
deltaReserves forall c. Lens' (InstantaneousRewards c) DeltaCoin
deltaReservesL
    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 DeltaCoin
deltaTreasury forall c. Lens' (InstantaneousRewards c) DeltaCoin
deltaTreasuryL

-- | A String that pretty prints the complete set of variables of the NewEpochState
allvars :: String
allvars :: String
allvars = forall a. Show a => a -> String
show (forall era r t. RootTarget era r t -> PDoc
ppTarget (forall era.
EraGov era =>
Proof era -> RootTarget era (NewEpochState era) (NewEpochState era)
newEpochStateT Proof (ConwayEra StandardCrypto)
Conway))

printTarget :: RootTarget era root t -> IO ()
printTarget :: forall era root t. RootTarget era root t -> IO ()
printTarget RootTarget era root t
t = String -> IO ()
putStrLn (forall a. Show a => a -> String
show (forall era r t. RootTarget era r t -> PDoc
ppTarget RootTarget era root t
t))

-- =====================================================================
-- PParams fields

-- | ProtVer in pparams
protVer :: Era era => Proof era -> Term era ProtVer
protVer :: forall era. Era era => Proof era -> Term era ProtVer
protVer Proof era
proof =
  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
proof
        String
"protVer"
        (forall era. Era era => Proof era -> Rep era ProtVer
ProtVerR Proof era
proof)
        (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
proof) forall a b. (a -> b) -> a -> b
$ forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
proof (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL))
    )

-- | ProtVer in prevPParams
prevProtVer :: Era era => Proof era -> Term era ProtVer
prevProtVer :: forall era. Era era => Proof era -> Term era ProtVer
prevProtVer Proof era
proof =
  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
proof
        String
"prevProtVer"
        (forall era. Era era => Proof era -> Rep era ProtVer
ProtVerR Proof era
proof)
        (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
proof) forall a b. (a -> b) -> a -> b
$ forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
proof (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL))
    )

minFeeA :: Era era => Proof era -> Term era Coin
minFeeA :: forall era. Era era => Proof era -> Term era Coin
minFeeA Proof era
proof =
  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
proof
        String
"minFeeA"
        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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
proof) forall a b. (a -> b) -> a -> b
$ forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
proof (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeAL))
    )

minFeeB :: Era era => Proof era -> Term era Coin
minFeeB :: forall era. Era era => Proof era -> Term era Coin
minFeeB Proof era
proof =
  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
proof
        String
"minFeeB"
        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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
proof) forall a b. (a -> b) -> a -> b
$ forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
proof (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppMinFeeBL))
    )

-- | Max Block Body Size
maxBBSize :: Era era => Proof era -> Term era Natural
maxBBSize :: forall era. Era era => Proof era -> Term era Natural
maxBBSize 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
"maxBBSize"
        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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxBBSizeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Word32 Natural
word32NaturalL)))
    )

-- | Max Tx Size
maxTxSize :: Era era => Proof era -> Term era Natural
maxTxSize :: forall era. Era era => Proof era -> Term era Natural
maxTxSize 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
"maxTxSize"
        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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Word32
ppMaxTxSizeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Word32 Natural
word32NaturalL)))
    )

fromIntegralBounded ::
  forall a b.
  (HasCallStack, Integral a, Show a, Integral b, Bounded b, Show b) =>
  String ->
  a ->
  b
fromIntegralBounded :: forall a b.
(HasCallStack, Integral a, Show a, Integral b, Bounded b,
 Show b) =>
String -> a -> b
fromIntegralBounded String
name a
x
  | forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: b) forall a. Ord a => a -> a -> Bool
<= Integer
xi Bool -> Bool -> Bool
&& Integer
xi forall a. Ord a => a -> a -> Bool
<= forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: b) = forall a b. (Integral a, Num b) => a -> b
fromIntegral a
x
  | Bool
otherwise =
      forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$
        String
"While converting "
          forall a. [a] -> [a] -> [a]
++ String
name
          forall a. [a] -> [a] -> [a]
++ String
", "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show a
x forall a. Semigroup a => a -> a -> a
<> String
" is out of bounds: " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall a. Bounded a => a
minBound :: b, forall a. Bounded a => a
maxBound :: b)
  where
    xi :: Integer
xi = forall a. Integral a => a -> Integer
toInteger a
x

word32NaturalL :: Lens' Word32 Natural
word32NaturalL :: Lens' Word32 Natural
word32NaturalL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a b. (Integral a, Num b) => a -> b
fromIntegral (\Word32
_ Natural
y -> forall a b.
(HasCallStack, Integral a, Show a, Integral b, Bounded b,
 Show b) =>
String -> a -> b
fromIntegralBounded String
"word32NaturaL" (forall a. Integral a => a -> Integer
toInteger Natural
y))

word16NaturalL :: Lens' Word16 Natural
word16NaturalL :: Lens' Word16 Natural
word16NaturalL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a b. (Integral a, Num b) => a -> b
fromIntegral (\Word16
_ Natural
y -> forall a b.
(HasCallStack, Integral a, Show a, Integral b, Bounded b,
 Show b) =>
String -> a -> b
fromIntegralBounded String
"word16NaturalL" (forall a. Integral a => a -> Integer
toInteger Natural
y))

-- | Max Block Header Size
maxBHSize :: Era era => Proof era -> Term era Natural
maxBHSize :: forall era. Era era => Proof era -> Term era Natural
maxBHSize 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
"maxBHSize"
        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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Word16
ppMaxBHSizeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. Lens' Word16 Natural
word16NaturalL)))
    )

poolDepAmt :: Era era => Proof era -> Term era Coin
poolDepAmt :: forall era. Era era => Proof era -> Term era Coin
poolDepAmt 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
"poolDepAmt"
      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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppPoolDepositL)))

keyDepAmt :: Era era => Proof era -> Term era Coin
keyDepAmt :: forall era. Era era => Proof era -> Term era Coin
keyDepAmt 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
"keyDepAmt"
      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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) Coin
ppKeyDepositL)))

proposalDeposit :: ConwayEraPParams era => Proof era -> Term era Coin
proposalDeposit :: forall era. ConwayEraPParams era => Proof era -> Term era Coin
proposalDeposit 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
"proposalDeposit"
      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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppGovActionDepositL)))

maxTxExUnits :: AlonzoEraPParams era => Proof era -> Term era ExUnits
maxTxExUnits :: forall era. AlonzoEraPParams era => Proof era -> Term era ExUnits
maxTxExUnits 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
"maxTxExUnits"
      forall era. Rep era ExUnits
ExUnitsR
      (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoEraPParams era => Lens' (PParams era) ExUnits
ppMaxTxExUnitsL)))

collateralPercentage :: AlonzoEraPParams era => Proof era -> Term era Natural
collateralPercentage :: forall era. AlonzoEraPParams era => Proof era -> Term era Natural
collateralPercentage 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
"collateralPercentage"
      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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. AlonzoEraPParams era => Lens' (PParams era) Natural
ppCollateralPercentageL)))

drepDeposit :: ConwayEraPParams era => Proof era -> Term era Coin
drepDeposit :: forall era. ConwayEraPParams era => Proof era -> Term era Coin
drepDeposit 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
"drepDeposit" 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 => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ConwayEraPParams era => Lens' (PParams era) Coin
ppDRepDepositL)))

drepActivity :: ConwayEraPParams era => Proof era -> Term era Base.EpochInterval
drepActivity :: forall era.
ConwayEraPParams era =>
Proof era -> Term era EpochInterval
drepActivity 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
"drepActivty"
      forall era. Rep era EpochInterval
EpochIntervalR
      (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
ConwayEraPParams era =>
Lens' (PParams era) EpochInterval
ppDRepActivityL)))

maxEpoch :: Era era => Proof era -> Term era Base.EpochInterval
maxEpoch :: forall era. Era era => Proof era -> Term era EpochInterval
maxEpoch 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
"maxEpoch"
      forall era. Rep era EpochInterval
EpochIntervalR
      (forall era s t. Rep era s -> Lens' s t -> Access era s t
Yes (forall era. Era era => Proof era -> Rep era (PParamsF era)
PParamsR Proof era
p) (forall era a. Proof era -> (EraPParams era => a) -> a
withEraPParams Proof era
p (forall era. Lens' (PParamsF era) (PParams era)
pparamsWrapperL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraPParams era => Lens' (PParams era) EpochInterval
ppEMaxL)))

-- =================================================================
-- TxBody vars

txbodyterm :: Reflect era => Term era (TxBodyF era)
txbodyterm :: forall era. Reflect era => Term era (TxBodyF era)
txbodyterm = 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
"txbodyterm" (forall era. Era era => Proof era -> Rep era (TxBodyF era)
TxBodyR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No

inputs :: Era era => Term era (Set (TxIn (EraCrypto era)))
inputs :: forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
inputs = 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
"inputs" (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

collateral :: Era era => Term era (Set (TxIn (EraCrypto era)))
collateral :: forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
collateral = 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
"collateral" (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

refInputs :: Era era => Term era (Set (TxIn (EraCrypto era)))
refInputs :: forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
refInputs = 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
"refInputs" (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

outputs :: Era era => Proof era -> Term era [TxOutF era]
outputs :: forall era. Era era => Proof era -> Term era [TxOutF era]
outputs 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
"outputs" (forall era t. Rep era t -> Rep era [t]
ListR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof era
p)) forall era s t. Access era s t
No

collateralReturn :: Era era => Proof era -> Term era (TxOutF era)
collateralReturn :: forall era. Era era => Proof era -> Term era (TxOutF era)
collateralReturn 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
"collateralReturn" (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR Proof era
p) forall era s t. Access era s t
No

-- | The sum of all the 'collateral' inputs. The Tx is constucted
--   by SNothing or wrapping 'SJust' around this value.
totalCol :: Era era => Term era Coin
totalCol :: forall era. Era era => Term era Coin
totalCol = 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
"totalCol" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

certs :: Reflect era => Term era [TxCertF era]
certs :: forall era. Reflect era => Term era [TxCertF era]
certs = 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
"certs" (forall era t. Rep era t -> Rep era [t]
ListR (forall era. Era era => Proof era -> Rep era (TxCertF era)
TxCertR forall era. Reflect era => Proof era
reify)) forall era s t. Access era s t
No

withdrawals :: forall era. Era era => Term era (Map (RewardAccount (EraCrypto era)) Coin)
withdrawals :: forall era.
Era era =>
Term era (Map (RewardAccount (EraCrypto era)) Coin)
withdrawals = 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
"withdrawals" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR (forall era. Era era => Rep era (RewardAccount (EraCrypto era))
RewardAccountR @era) forall era. Rep era Coin
CoinR) forall era s t. Access era s t
No

txfee :: Era era => Term era Coin
txfee :: forall era. Era era => Term era Coin
txfee = 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
"txfee" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

ttl :: Era era => Term era SlotNo
ttl :: forall era. Era era => Term era SlotNo
ttl = 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
"ttl" forall era. Rep era SlotNo
SlotNoR forall era s t. Access era s t
No

validityInterval :: Era era => Term era ValidityInterval
validityInterval :: forall era. Era era => Term era ValidityInterval
validityInterval = 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
"validityInterval" forall era. Era era => Rep era ValidityInterval
ValidityIntervalR forall era s t. Access era s t
No

mint :: Era era => Term era (Map (ScriptHash (EraCrypto era)) (Map AssetName Integer))
mint :: forall era.
Era era =>
Term era (Map (ScriptHash (EraCrypto era)) (Map AssetName Integer))
mint = 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
"mint" (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 t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Rep era AssetName
AssetNameR forall era. Rep era Integer
IntegerR)) forall era s t. Access era s t
No

reqSignerHashes :: Era era => Term era (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashes :: forall era.
Era era =>
Term era (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashes = 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
"reqSignerHashes" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR forall era. Era era => Rep era (KeyHash 'Witness (EraCrypto era))
WitHashR) forall era s t. Access era s t
No

networkID :: Era era => Term era (Maybe Network)
networkID :: forall era. Era era => Term era (Maybe Network)
networkID = 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
"networkID" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Rep era Network
NetworkR) forall era s t. Access era s t
No

adHash :: Era era => Term era (Maybe (AuxiliaryDataHash (EraCrypto era)))
adHash :: forall era.
Era era =>
Term era (Maybe (AuxiliaryDataHash (EraCrypto era)))
adHash = 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
"adHash" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Era era => Rep era (AuxiliaryDataHash (EraCrypto era))
AuxiliaryDataHashR) forall era s t. Access era s t
No

wppHash :: Era era => Term era (Maybe (SafeHash (EraCrypto era) EraIndependentScriptIntegrity))
wppHash :: forall era.
Era era =>
Term
  era
  (Maybe (SafeHash (EraCrypto era) EraIndependentScriptIntegrity))
wppHash = 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
"wppHash" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era.
Era era =>
Rep era (SafeHash (EraCrypto era) EraIndependentScriptIntegrity)
ScriptIntegrityHashR) forall era s t. Access era s t
No

txDonation :: Era era => Term era Coin
txDonation :: forall era. Era era => Term era Coin
txDonation = 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
"txDonation" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

-- | lift the model type of 'mint' into a MultiAsset
liftMultiAsset :: Map (ScriptHash c) (Map AssetName Integer) -> MultiAsset c
liftMultiAsset :: forall c.
Map (ScriptHash c) (Map AssetName Integer) -> MultiAsset c
liftMultiAsset Map (ScriptHash c) (Map AssetName Integer)
m = forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset (forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall c. ScriptHash c -> PolicyID c
PolicyID Map (ScriptHash c) (Map AssetName Integer)
m)

scriptsNeeded :: Reflect era => Term era (ScriptsNeededF era)
scriptsNeeded :: forall era. Reflect era => Term era (ScriptsNeededF era)
scriptsNeeded = 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
"scriptsNeeded" (forall era. Era era => Proof era -> Rep era (ScriptsNeededF era)
ScriptsNeededR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No

smNeededL ::
  ScriptsNeeded era ~ ShelleyScriptsNeeded era =>
  Lens' (ScriptsNeededF era) (Set (ScriptHash (EraCrypto era)))
smNeededL :: forall era.
(ScriptsNeeded era ~ ShelleyScriptsNeeded era) =>
Lens' (ScriptsNeededF era) (Set (ScriptHash (EraCrypto era)))
smNeededL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(ScriptsNeededF Proof era
_ (ShelleyScriptsNeeded Set (ScriptHash (EraCrypto era))
s)) -> Set (ScriptHash (EraCrypto era))
s)
    (\(ScriptsNeededF Proof era
p ScriptsNeeded era
_) Set (ScriptHash (EraCrypto era))
s -> forall era. Proof era -> ScriptsNeeded era -> ScriptsNeededF era
ScriptsNeededF Proof era
p (forall era.
Set (ScriptHash (EraCrypto era)) -> ShelleyScriptsNeeded era
ShelleyScriptsNeeded Set (ScriptHash (EraCrypto era))
s))

acNeededL ::
  ScriptsNeeded era ~ AlonzoScriptsNeeded era =>
  Lens' (ScriptsNeededF era) [(PlutusPurposeF era, ScriptHash (EraCrypto era))]
acNeededL :: forall era.
(ScriptsNeeded era ~ AlonzoScriptsNeeded era) =>
Lens'
  (ScriptsNeededF era)
  [(PlutusPurposeF era, ScriptHash (EraCrypto era))]
acNeededL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(ScriptsNeededF Proof era
p (AlonzoScriptsNeeded [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
s)) -> forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (forall era.
Proof era -> PlutusPurpose AsIxItem era -> PlutusPurposeF era
PlutusPurposeF Proof era
p)) [(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
s)
    ( \(ScriptsNeededF Proof era
p ScriptsNeeded era
_) [(PlutusPurposeF era, ScriptHash (EraCrypto era))]
s ->
        forall era. Proof era -> ScriptsNeeded era -> ScriptsNeededF era
ScriptsNeededF Proof era
p (forall era.
[(PlutusPurpose AsIxItem era, ScriptHash (EraCrypto era))]
-> AlonzoScriptsNeeded era
AlonzoScriptsNeeded (forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall era. PlutusPurposeF era -> PlutusPurpose AsIxItem era
unPlutusPurposeF) [(PlutusPurposeF era, ScriptHash (EraCrypto era))]
s))
    )

-- ===============
-- Auxliary Vars to compute collateral

-- | A Coin that needs to be added to the range of the colInputs in the UtxO
--   that will make sure the collateral is large enough to pay the fees if needed
extraCol :: Era era => Term era Coin
extraCol :: forall era. Era era => Term era Coin
extraCol = 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
"extraCol" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

-- | The sum of all the 'collateral' inputs, total colateral of the Tx is computed by adding (SJust _) to this value.
sumCol :: Era era => Term era Coin
sumCol :: forall era. Era era => Term era Coin
sumCol = 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
"sumCol" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

colRetAddr :: Era era => Term era (Addr (EraCrypto era))
colRetAddr :: forall era. Era era => Term era (Addr (EraCrypto era))
colRetAddr = 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
"colRetAddr" forall era. Era era => Rep era (Addr (EraCrypto era))
AddrR forall era s t. Access era s t
No

-- | The Coin in the 'collateralReturn' TxOut
colRetCoin :: Era era => Term era Coin
colRetCoin :: forall era. Era era => Term era Coin
colRetCoin = 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
"colRetCoin" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

-- | The amount that the collateral must cover if there is a two phase error.
--   This is roughly the 'collateralPercentage' * 'txfee' . The calculation deals with rounding,
--   but you don't need those details to understand what is going on.
owed :: Era era => Term era Coin
owed :: forall era. Era era => Term era Coin
owed = 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
"owed" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

-- ==============================================================
-- Tx Vars

txbody :: Reflect era => Term era (TxBodyF era)
txbody :: forall era. Reflect era => Term era (TxBodyF era)
txbody = 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
"txbody" (forall era. Era era => Proof era -> Rep era (TxBodyF era)
TxBodyR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No

txwits :: Reflect era => Term era (TxWitsF era)
txwits :: forall era. Reflect era => Term era (TxWitsF era)
txwits = 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
"txwits" (forall era. Era era => Proof era -> Rep era (TxWitsF era)
TxWitsR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No

txauxdata :: Reflect era => Term era (Maybe (TxAuxDataF era))
txauxdata :: forall era. Reflect era => Term era (Maybe (TxAuxDataF era))
txauxdata = 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
"txauxdata" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR (forall era. Era era => Proof era -> Rep era (TxAuxDataF era)
TxAuxDataR forall era. Reflect era => Proof era
reify)) forall era s t. Access era s t
No

txisvalid :: Era era => Term era IsValid
txisvalid :: forall era. Era era => Term era IsValid
txisvalid = 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
"txisvalid" forall era. Rep era IsValid
IsValidR forall era s t. Access era s t
No

valids :: Era era => Term era [IsValid]
valids :: forall era. Era era => Term era [IsValid]
valids = 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
"valids" (forall era t. Rep era t -> Rep era [t]
ListR forall era. Rep era IsValid
IsValidR) forall era s t. Access era s t
No

txterm :: Reflect era => Term era (TxF era)
txterm :: forall era. Reflect era => Term era (TxF era)
txterm = 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
"txterm" (forall era. Era era => Proof era -> Rep era (TxF era)
TxR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No

-- ==============================================================
-- Terms and Fields for use in TxOut and TxBody

-- Lenses for use in TxBody

getRwdCredL :: Lens' (RewardAccount c) (Credential 'Staking c)
getRwdCredL :: forall c. Lens' (RewardAccount c) (Credential 'Staking c)
getRwdCredL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall c. RewardAccount c -> Credential 'Staking c
raCredential (\RewardAccount c
r Credential 'Staking c
c -> RewardAccount c
r {raCredential :: Credential 'Staking c
raCredential = Credential 'Staking c
c})

txOutFL :: Lens' (TxOutF era) (TxOut era)
txOutFL :: forall era. Lens' (TxOutF era) (TxOut era)
txOutFL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. TxOutF era -> TxOut era
unTxOut (\(TxOutF Proof era
p TxOut era
_) TxOut era
y -> forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p TxOut era
y)

valueFL :: Reflect era => Lens' (Value era) (ValueF era)
valueFL :: forall era. Reflect era => Lens' (Value era) (ValueF era)
valueFL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall era. Proof era -> Value era -> ValueF era
ValueF forall era. Reflect era => Proof era
reify) (\Value era
_ (ValueF Proof era
_ Value era
u) -> Value era
u)

lensVC :: Val t => Lens' t Coin
lensVC :: forall t. Val t => Lens' t Coin
lensVC = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall t. Val t => t -> Coin
coin forall a b. (a -> b) -> a -> b
$ \t
t Coin
c -> forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin (forall a b. a -> b -> a
const Coin
c) t
t

valueFCoinL :: (HasCallStack, Reflect era) => Lens' (ValueF era) Coin
valueFCoinL :: forall era. (HasCallStack, Reflect era) => Lens' (ValueF era) Coin
valueFCoinL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (forall t. Val t => t -> Coin
coin forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ValueF era -> Value era
unValue)
    ( \(ValueF Proof era
p Value era
v) c :: Coin
c@(Coin Integer
i) ->
        if Integer
i forall a. Ord a => a -> a -> Bool
< Integer
0
          then forall a. HasCallStack => String -> a
error (String
"Coin is less than 0 " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
i forall a. [a] -> [a] -> [a]
++ String
" in valueFCoinL")
          else (forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (forall t. Val t => (Coin -> Coin) -> t -> t
modifyCoin (forall a b. a -> b -> a
const Coin
c) Value era
v))
    )

outputCoinL :: (HasCallStack, Reflect era) => Lens' (TxOutF era) Coin
outputCoinL :: forall era. (HasCallStack, Reflect era) => Lens' (TxOutF era) Coin
outputCoinL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(TxOutF Proof era
_ TxOut era
out) -> TxOut era
out forall s a. s -> Getting a s a -> a
^. forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL)
    (\(TxOutF Proof era
p TxOut era
out) Coin
c -> forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
p (TxOut era
out forall a b. a -> (a -> b) -> b
& forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
coinTxOutL forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
c))

-- | a Field from (ValueF era) to Coin
valCoinF :: (HasCallStack, Reflect era) => Field era (ValueF era) Coin
valCoinF :: forall era.
(HasCallStack, Reflect era) =>
Field era (ValueF era) Coin
valCoinF = forall era t s.
Era era =>
String -> Rep era t -> Rep era s -> Lens' s t -> Field era s t
Field String
"valCoin" forall era. Rep era Coin
CoinR (forall era. Era era => Proof era -> Rep era (ValueF era)
ValueR forall era. Reflect era => Proof era
reify) forall era. (HasCallStack, Reflect era) => Lens' (ValueF era) Coin
valueFCoinL

valCoin :: (HasCallStack, Reflect era) => Term era Coin
valCoin :: forall era. (HasCallStack, Reflect era) => Term era Coin
valCoin = forall era rec field. Field era rec field -> Term era field
fieldToTerm forall era.
(HasCallStack, Reflect era) =>
Field era (ValueF era) Coin
valCoinF

maryValueMultiAssetL :: Lens' (MaryValue c) (MultiAsset c)
maryValueMultiAssetL :: forall c. Lens' (MaryValue c) (MultiAsset c)
maryValueMultiAssetL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(MaryValue Coin
_ MultiAsset c
ma) -> MultiAsset c
ma)
    (\(MaryValue Coin
c MultiAsset c
_) MultiAsset c
ma -> forall c. Coin -> MultiAsset c -> MaryValue c
MaryValue Coin
c MultiAsset c
ma)

valueFMultiAssetL :: Lens' (ValueF era) (MultiAsset (EraCrypto era))
valueFMultiAssetL :: forall era. Lens' (ValueF era) (MultiAsset (EraCrypto era))
valueFMultiAssetL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era. ValueF era -> MultiAsset (EraCrypto era)
get forall era. ValueF era -> MultiAsset (EraCrypto era) -> ValueF era
put
  where
    get :: ValueF era -> MultiAsset (EraCrypto era)
    get :: forall era. ValueF era -> MultiAsset (EraCrypto era)
get (ValueF Proof era
p Value era
x) = case forall era. Proof era -> ValueWit era
whichValue Proof era
p of
      ValueWit era
ValueShelleyToAllegra -> forall c. Map (PolicyID c) (Map AssetName Integer) -> MultiAsset c
MultiAsset forall k a. Map k a
Map.empty
      ValueWit era
ValueMaryToConway -> Value era
x forall s a. s -> Getting a s a -> a
^. forall c. Lens' (MaryValue c) (MultiAsset c)
maryValueMultiAssetL

    put :: ValueF era -> MultiAsset (EraCrypto era) -> ValueF era
    put :: forall era. ValueF era -> MultiAsset (EraCrypto era) -> ValueF era
put (ValueF Proof era
p Value era
x) MultiAsset (EraCrypto era)
new = case forall era. Proof era -> ValueWit era
whichValue Proof era
p of
      ValueWit era
ValueShelleyToAllegra -> forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p Value era
x
      ValueWit era
ValueMaryToConway -> forall era. Proof era -> Value era -> ValueF era
ValueF Proof era
p (Value era
x forall a b. a -> (a -> b) -> b
& forall c. Lens' (MaryValue c) (MultiAsset c)
maryValueMultiAssetL forall s t a b. ASetter s t a b -> b -> s -> t
.~ MultiAsset (EraCrypto era)
new)

-- | a Field from (ValueF era) to MultiAsset
valueFMultiAssetF :: Reflect era => Field era (ValueF era) (MultiAsset (EraCrypto era))
valueFMultiAssetF :: forall era.
Reflect era =>
Field era (ValueF era) (MultiAsset (EraCrypto era))
valueFMultiAssetF = forall era t s.
Era era =>
String -> Rep era t -> Rep era s -> Lens' s t -> Field era s t
Field String
"valueFMultiAsset" forall era. Era era => Rep era (MultiAsset (EraCrypto era))
MultiAssetR (forall era. Era era => Proof era -> Rep era (ValueF era)
ValueR forall era. Reflect era => Proof era
reify) forall era. Lens' (ValueF era) (MultiAsset (EraCrypto era))
valueFMultiAssetL

valueFMultiAsset :: Reflect era => Term era (MultiAsset (EraCrypto era))
valueFMultiAsset :: forall era. Reflect era => Term era (MultiAsset (EraCrypto era))
valueFMultiAsset = forall era rec field. Field era rec field -> Term era field
fieldToTerm forall era.
Reflect era =>
Field era (ValueF era) (MultiAsset (EraCrypto era))
valueFMultiAssetF

-- | a Field from (TxOut era) to (Addr era)
txoutAddressF :: Reflect era => Field era (TxOutF era) (Addr (EraCrypto era))
txoutAddressF :: forall era.
Reflect era =>
Field era (TxOutF era) (Addr (EraCrypto era))
txoutAddressF = forall era t s.
Era era =>
String -> Rep era t -> Rep era s -> Lens' s t -> Field era s t
Field String
"txoutAddress" forall era. Era era => Rep era (Addr (EraCrypto era))
AddrR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR forall era. Reflect era => Proof era
reify) (forall era. Lens' (TxOutF era) (TxOut era)
txOutFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
EraTxOut era =>
Lens' (TxOut era) (Addr (EraCrypto era))
addrTxOutL)

txoutAddress :: Reflect era => Term era (Addr (EraCrypto era))
txoutAddress :: forall era. Reflect era => Term era (Addr (EraCrypto era))
txoutAddress = forall era rec field. Field era rec field -> Term era field
fieldToTerm forall era.
Reflect era =>
Field era (TxOutF era) (Addr (EraCrypto era))
txoutAddressF

-- | a Field from (TxOutF era) to Coin
txoutCoinF :: (HasCallStack, Reflect era) => Field era (TxOutF era) Coin
txoutCoinF :: forall era.
(HasCallStack, Reflect era) =>
Field era (TxOutF era) Coin
txoutCoinF = forall era t s.
Era era =>
String -> Rep era t -> Rep era s -> Lens' s t -> Field era s t
Field String
"txoutCoin" forall era. Rep era Coin
CoinR (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR forall era. Reflect era => Proof era
reify) forall era. (HasCallStack, Reflect era) => Lens' (TxOutF era) Coin
outputCoinL

txoutCoin :: (HasCallStack, Reflect era) => Term era Coin
txoutCoin :: forall era. (HasCallStack, Reflect era) => Term era Coin
txoutCoin = forall era rec field. Field era rec field -> Term era field
fieldToTerm forall era.
(HasCallStack, Reflect era) =>
Field era (TxOutF era) Coin
txoutCoinF

-- | a Field from (TxOutF era) to (ValueF era)
txoutAmountF :: Reflect era => Field era (TxOutF era) (ValueF era)
txoutAmountF :: forall era. Reflect era => Field era (TxOutF era) (ValueF era)
txoutAmountF = forall era t s.
Era era =>
String -> Rep era t -> Rep era s -> Lens' s t -> Field era s t
Field String
"txoutAmount" (forall era. Era era => Proof era -> Rep era (ValueF era)
ValueR forall era. Reflect era => Proof era
reify) (forall era. Era era => Proof era -> Rep era (TxOutF era)
TxOutR forall era. Reflect era => Proof era
reify) (forall era. Lens' (TxOutF era) (TxOut era)
txOutFL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. EraTxOut era => Lens' (TxOut era) (Value era)
valueTxOutL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Reflect era => Lens' (Value era) (ValueF era)
valueFL)

txoutAmount :: Reflect era => Term era (ValueF era)
txoutAmount :: forall era. Reflect era => Term era (ValueF era)
txoutAmount = forall era rec field. Field era rec field -> Term era field
fieldToTerm forall era. Reflect era => Field era (TxOutF era) (ValueF era)
txoutAmountF

-- =================================
-- Witnesses

scriptWits :: Reflect era => Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
scriptWits :: forall era.
Reflect era =>
Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
scriptWits = 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
"scriptWits" (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 forall era. Reflect era => Proof era
reify)) forall era s t. Access era s t
No

redeemers :: Reflect era => Term era (Map (PlutusPointerF era) (Data era, ExUnits))
redeemers :: forall era.
Reflect era =>
Term era (Map (PlutusPointerF era) (Data era, ExUnits))
redeemers = 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
"redeemers" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR (forall era. Era era => Proof era -> Rep era (PlutusPointerF era)
RdmrPtrR forall era. Reflect era => Proof era
reify) (forall era t r. Rep era t -> Rep era r -> Rep era (t, r)
PairR forall era. Era era => Rep era (Data era)
DataR forall era. Rep era ExUnits
ExUnitsR)) forall era s t. Access era s t
No

bootWits :: forall era. Reflect era => Term era (Set (BootstrapWitness (EraCrypto era)))
bootWits :: forall era.
Reflect era =>
Term era (Set (BootstrapWitness (EraCrypto era)))
bootWits = 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
"bootWits" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR (forall era. Era era => Rep era (BootstrapWitness (EraCrypto era))
BootstrapWitnessR @era)) forall era s t. Access era s t
No

dataWits :: Reflect era => Term era (Map (DataHash (EraCrypto era)) (Data era))
dataWits :: forall era.
Reflect era =>
Term era (Map (DataHash (EraCrypto era)) (Data era))
dataWits = 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
"dataWits" (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

keyWits :: Reflect era => Term era (Set (WitVKey 'Witness (EraCrypto era)))
keyWits :: forall era.
Reflect era =>
Term era (Set (WitVKey 'Witness (EraCrypto era)))
keyWits = 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
"keyWits" (forall t era. Ord t => Rep era t -> Rep era (Set t)
SetR (forall era.
Era era =>
Proof era -> Rep era (WitVKey 'Witness (EraCrypto era))
WitVKeyR forall era. Reflect era => Proof era
reify)) forall era s t. Access era s t
No

-- =======================================================================================
-- Targets for building Transactions and their components. Since we compute these in two
-- passes, the targets are parameterized by the things that change between the first and
-- second passes. Here is an accounting of the things that change
-- 1) witsTarget: The witnesses that depend on the hash of the TxBody 'bootWits' and 'keyWits'
-- 2) txbodyTarget: 'txfee' , 'totaland 'wppHash'
-- 3) txTarget:  'txbodyterm', 'bootWits', and 'keyWits', since a Tx has both a body and witnesses

witsTarget ::
  Reflect era =>
  Term era (Set (BootstrapWitness (EraCrypto era))) ->
  Term era (Set (WitVKey 'Witness (EraCrypto era))) ->
  Target era (TxWits era)
witsTarget :: forall era.
Reflect era =>
Term era (Set (BootstrapWitness (EraCrypto era)))
-> Term era (Set (WitVKey 'Witness (EraCrypto era)))
-> Target era (TxWits era)
witsTarget Term era (Set (BootstrapWitness (EraCrypto era)))
bootWitsParam Term era (Set (WitVKey 'Witness (EraCrypto era)))
keyWitsParam =
  forall t r era. String -> (t -> r) -> RootTarget era Void (t -> r)
Constr String
"TxWits" Map (ScriptHash (EraCrypto era)) (ScriptF era)
-> Map (PlutusPointerF era) (Data era, ExUnits)
-> Set (BootstrapWitness (EraCrypto era))
-> Map (DataHash StandardCrypto) (Data era)
-> Set (WitVKey 'Witness (EraCrypto era))
-> TxWits era
witsf forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Reflect era =>
Term era (Map (ScriptHash (EraCrypto era)) (ScriptF era))
scriptWits forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Reflect era =>
Term era (Map (PlutusPointerF era) (Data era, ExUnits))
redeemers forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (BootstrapWitness (EraCrypto era)))
bootWitsParam forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Reflect era =>
Term era (Map (DataHash (EraCrypto era)) (Data era))
dataWits forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Set (WitVKey 'Witness (EraCrypto era)))
keyWitsParam
  where
    proof :: Proof era
proof = forall era. Reflect era => Proof era
reify
    witsf :: Map (ScriptHash (EraCrypto era)) (ScriptF era)
-> Map (PlutusPointerF era) (Data era, ExUnits)
-> Set (BootstrapWitness (EraCrypto era))
-> Map (DataHash StandardCrypto) (Data era)
-> Set (WitVKey 'Witness (EraCrypto era))
-> TxWits era
witsf Map (ScriptHash (EraCrypto era)) (ScriptF era)
script Map (PlutusPointerF era) (Data era, ExUnits)
redeem Set (BootstrapWitness (EraCrypto era))
boot Map (DataHash StandardCrypto) (Data era)
dataw Set (WitVKey 'Witness (EraCrypto era))
key =
      forall era.
Era era =>
Policy -> Proof era -> [WitnessesField era] -> TxWits era
newWitnesses
        Policy
merge
        Proof era
proof
        [ forall era.
Set (WitVKey 'Witness (EraCrypto era)) -> WitnessesField era
AddrWits Set (WitVKey 'Witness (EraCrypto era))
key
        , forall era.
Set (BootstrapWitness (EraCrypto era)) -> WitnessesField era
BootWits Set (BootstrapWitness (EraCrypto era))
boot
        , forall era.
Map (ScriptHash (EraCrypto era)) (Script era) -> WitnessesField era
ScriptWits (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall era. ScriptF era -> Script era
unScriptF Map (ScriptHash (EraCrypto era)) (ScriptF era)
script)
        , forall era. TxDats era -> WitnessesField era
DataWits (forall era.
Era era =>
Map (DataHash (EraCrypto era)) (Data era) -> TxDats era
TxDats Map (DataHash StandardCrypto) (Data era)
dataw)
        , forall era. Redeemers era -> WitnessesField era
RdmrWits (forall era.
Proof era
-> [(PlutusPurpose AsIx era, (Data era, ExUnits))] -> Redeemers era
mkRedeemers Proof era
proof forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall era. PlutusPointerF era -> PlutusPurpose AsIx era
unPlutusPointerF) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
Map.toList forall a b. (a -> b) -> a -> b
$ Map (PlutusPointerF era) (Data era, ExUnits)
redeem)
        ]

txTarget ::
  Reflect era =>
  Term era (TxBodyF era) ->
  Term era (Set (BootstrapWitness (EraCrypto era))) ->
  Term era (Set (WitVKey 'Witness (EraCrypto era))) ->
  Target era (TxF era)
txTarget :: forall era.
Reflect era =>
Term era (TxBodyF era)
-> Term era (Set (BootstrapWitness (EraCrypto era)))
-> Term era (Set (WitVKey 'Witness (EraCrypto era)))
-> Target era (TxF era)
txTarget Term era (TxBodyF era)
bodyparam Term era (Set (BootstrapWitness (EraCrypto era)))
bootWitsParam Term era (Set (WitVKey 'Witness (EraCrypto era)))
keyWitsParam =
  forall t r era. String -> (t -> r) -> RootTarget era Void (t -> r)
Constr String
"tx" forall {era}.
TxBodyF era
-> TxWits era -> Maybe (TxAuxDataF era) -> IsValid -> TxF era
txf forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (TxBodyF era)
bodyparam forall era r t b.
RootTarget era r (t -> b)
-> RootTarget era r t -> RootTarget era r b
:$ Target era (TxWits era)
wits forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Reflect era => Term era (Maybe (TxAuxDataF era))
txauxdata forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era IsValid
txisvalid
  where
    wits :: Target era (TxWits era)
wits = forall era.
Reflect era =>
Term era (Set (BootstrapWitness (EraCrypto era)))
-> Term era (Set (WitVKey 'Witness (EraCrypto era)))
-> Target era (TxWits era)
witsTarget Term era (Set (BootstrapWitness (EraCrypto era)))
bootWitsParam Term era (Set (WitVKey 'Witness (EraCrypto era)))
keyWitsParam
    txf :: TxBodyF era
-> TxWits era -> Maybe (TxAuxDataF era) -> IsValid -> TxF era
txf (TxBodyF Proof era
proof TxBody era
txb) TxWits era
w Maybe (TxAuxDataF era)
auxs IsValid
isvalid =
      forall era. Proof era -> Tx era -> TxF era
TxF Proof era
proof (forall era. Proof era -> [TxField era] -> Tx era
newTx Proof era
proof [forall era. TxBody era -> TxField era
Body TxBody era
txb, forall era. TxWits era -> TxField era
TxWits TxWits era
w, forall era. [TxAuxData era] -> TxField era
AuxData' (forall {era}. Maybe (TxAuxDataF era) -> [TxAuxData era]
fixM Maybe (TxAuxDataF era)
auxs), forall era. IsValid -> TxField era
Valid IsValid
isvalid])
    fixM :: Maybe (TxAuxDataF era) -> [TxAuxData era]
fixM Maybe (TxAuxDataF era)
Nothing = []
    fixM (Just (TxAuxDataF Proof era
_ TxAuxData era
x)) = [TxAuxData era
x]

-- | Need to build the TxBody with different terms that control the fee and wppHash so we
--   parameterise this target over those two terms
txbodyTarget ::
  Reflect era =>
  Term era Coin ->
  Term era (Maybe (ScriptIntegrityHash (EraCrypto era))) ->
  Term era Coin ->
  Target era (TxBodyF era)
txbodyTarget :: forall era.
Reflect era =>
Term era Coin
-> Term era (Maybe (ScriptIntegrityHash (EraCrypto era)))
-> Term era Coin
-> Target era (TxBodyF era)
txbodyTarget Term era Coin
feeparam Term era (Maybe (ScriptIntegrityHash (EraCrypto era)))
wpphashparam Term era Coin
totalColParam =
  forall t r era. String -> (t -> r) -> RootTarget era Void (t -> r)
Constr String
"txbody" Set (TxIn StandardCrypto)
-> Set (TxIn StandardCrypto)
-> Set (TxIn StandardCrypto)
-> [TxOutF era]
-> TxOutF era
-> Coin
-> [TxCertF era]
-> Map (RewardAcnt StandardCrypto) Coin
-> SlotNo
-> ValidityInterval
-> Map (ScriptHash StandardCrypto) (Map AssetName Integer)
-> Set (KeyHash 'Witness StandardCrypto)
-> Maybe Network
-> Maybe (AuxiliaryDataHash StandardCrypto)
-> Maybe (ScriptIntegrityHash StandardCrypto)
-> Coin
-> Coin
-> TxBodyF era
txbodyf
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
inputs
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
collateral
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era (Set (TxIn (EraCrypto era)))
refInputs
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (forall era. Era era => Proof era -> Term era [TxOutF era]
outputs Proof era
proof)
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (forall era. Era era => Proof era -> Term era (TxOutF era)
collateralReturn Proof era
proof)
    -- \^$ updates
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era Coin
totalColParam
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Reflect era => Term era [TxCertF era]
certs
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Era era =>
Term era (Map (RewardAccount (EraCrypto era)) Coin)
withdrawals
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era SlotNo
ttl
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era ValidityInterval
validityInterval
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Era era =>
Term era (Map (ScriptHash (EraCrypto era)) (Map AssetName Integer))
mint
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Era era =>
Term era (Set (KeyHash 'Witness (EraCrypto era)))
reqSignerHashes
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era (Maybe Network)
networkID
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era.
Era era =>
Term era (Maybe (AuxiliaryDataHash (EraCrypto era)))
adHash
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Maybe (ScriptIntegrityHash (EraCrypto era)))
wpphashparam
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era Coin
feeparam
    forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Term era Coin
txDonation
  where
    proof :: Proof era
proof = forall era. Reflect era => Proof era
reify
    txbodyf :: Set (TxIn StandardCrypto)
-> Set (TxIn StandardCrypto)
-> Set (TxIn StandardCrypto)
-> [TxOutF era]
-> TxOutF era
-> Coin
-> [TxCertF era]
-> Map (RewardAcnt StandardCrypto) Coin
-> SlotNo
-> ValidityInterval
-> Map (ScriptHash StandardCrypto) (Map AssetName Integer)
-> Set (KeyHash 'Witness StandardCrypto)
-> Maybe Network
-> Maybe (AuxiliaryDataHash StandardCrypto)
-> Maybe (ScriptIntegrityHash StandardCrypto)
-> Coin
-> Coin
-> TxBodyF era
txbodyf
      Set (TxIn StandardCrypto)
ins
      Set (TxIn StandardCrypto)
col
      Set (TxIn StandardCrypto)
refs
      [TxOutF era]
out
      (TxOutF Proof era
_ TxOut era
colret)
      Coin
totcol
      --    updates
      [TxCertF era]
cs
      Map (RewardAcnt StandardCrypto) Coin
ws
      SlotNo
tt
      ValidityInterval
vi
      Map (ScriptHash StandardCrypto) (Map AssetName Integer)
mnt
      Set (KeyHash 'Witness StandardCrypto)
req
      Maybe Network
net
      Maybe (AuxiliaryDataHash StandardCrypto)
adh
      Maybe (ScriptIntegrityHash StandardCrypto)
wpp
      Coin
fee
      Coin
donate =
        forall era. Proof era -> TxBody era -> TxBodyF era
TxBodyF
          Proof era
proof
          ( forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody
              Proof era
proof
              [ forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Inputs Set (TxIn StandardCrypto)
ins
              , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
Collateral Set (TxIn StandardCrypto)
col
              , forall era. Set (TxIn (EraCrypto era)) -> TxBodyField era
RefInputs Set (TxIn StandardCrypto)
refs
              , forall era. [TxOut era] -> TxBodyField era
Outputs' (forall a b. (a -> b) -> [a] -> [b]
map forall era. TxOutF era -> TxOut era
unTxOut [TxOutF era]
out)
              , forall era. StrictMaybe (TxOut era) -> TxBodyField era
CollateralReturn (forall a. a -> StrictMaybe a
SJust TxOut era
colret)
              , -- , Update upd
                forall era. StrictMaybe Coin -> TxBodyField era
TotalCol (forall a. a -> StrictMaybe a
SJust Coin
totcol)
              , forall era. [TxCert era] -> TxBodyField era
Certs' (forall a b. (a -> b) -> [a] -> [b]
map forall era. TxCertF era -> TxCert era
unTxCertF [TxCertF era]
cs)
              , forall era. Withdrawals (EraCrypto era) -> TxBodyField era
Withdrawals' (forall c. Map (RewardAcnt c) Coin -> Withdrawals c
Withdrawals Map (RewardAcnt StandardCrypto) Coin
ws)
              , forall era. Coin -> TxBodyField era
Txfee Coin
fee
              , forall era. SlotNo -> TxBodyField era
TTL SlotNo
tt
              , forall era. ValidityInterval -> TxBodyField era
Vldt ValidityInterval
vi
              , forall era. MultiAsset (EraCrypto era) -> TxBodyField era
Fields.Mint (forall c.
Map (ScriptHash c) (Map AssetName Integer) -> MultiAsset c
liftMultiAsset Map (ScriptHash StandardCrypto) (Map AssetName Integer)
mnt)
              , forall era.
Set (KeyHash 'Witness (EraCrypto era)) -> TxBodyField era
ReqSignerHashes Set (KeyHash 'Witness StandardCrypto)
req
              , forall era. StrictMaybe Network -> TxBodyField era
Txnetworkid (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe Network
net)
              , forall era.
StrictMaybe (AuxiliaryDataHash (EraCrypto era)) -> TxBodyField era
AdHash (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (AuxiliaryDataHash StandardCrypto)
adh)
              , forall era.
StrictMaybe (ScriptIntegrityHash (EraCrypto era))
-> TxBodyField era
WppHash (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (ScriptIntegrityHash StandardCrypto)
wpp)
              , forall era. Coin -> TxBodyField era
TreasuryDonation Coin
donate
              ]
          )

-- ==================================================
-- Hardforks

allowMIRTransfer :: Proof era -> Term era Bool
allowMIRTransfer :: forall era. Proof era -> Term era Bool
allowMIRTransfer Proof era
p = forall era t. Rep era t -> t -> Term era t
Lit forall era. Rep era Bool
BoolR (ProtVer -> Bool
HardForks.allowMIRTransfer (forall era. Proof era -> ProtVer
protocolVersion Proof era
p))

-- ====================================
-- ConwayGovState variables

constitution :: Era era => Term era (Constitution era)
constitution :: forall era. Era era => Term era (Constitution era)
constitution = 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
"constitution" forall era. Era era => Rep era (Constitution era)
ConstitutionR forall era s t. Access era s t
No

enactTreasury :: Era era => Term era Coin
enactTreasury :: forall era. Era era => Term era Coin
enactTreasury = 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
"enactTreasury" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

enactWithdrawals :: forall era. Era era => Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
enactWithdrawals :: forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
enactWithdrawals = 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
"enactWithdrawals" (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

currentGovActionStates ::
  Era era => Term era (Map (GovActionId (EraCrypto era)) (GovActionState era))
currentGovActionStates :: forall era.
Era era =>
Term era (Map (GovActionId (EraCrypto era)) (GovActionState era))
currentGovActionStates = 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
"currentGovActionStates" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR forall era. Era era => Rep era (GovActionState era)
GovActionStateR) forall era s t. Access era s t
No

currentProposalOrder :: Era era => Term era [GovActionId (EraCrypto era)]
currentProposalOrder :: forall era. Era era => Term era [GovActionId (EraCrypto era)]
currentProposalOrder = 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
"currentProposalOrder" (forall era t. Rep era t -> Rep era [t]
ListR forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR) forall era s t. Access era s t
No

prevGovActionStates :: Era era => Term era (Map (GovActionId (EraCrypto era)) (GovActionState era))
prevGovActionStates :: forall era.
Era era =>
Term era (Map (GovActionId (EraCrypto era)) (GovActionState era))
prevGovActionStates = 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
"prevGovActionStates" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR forall era. Era era => Rep era (GovActionState era)
GovActionStateR) forall era s t. Access era s t
No

prevProposalOrder :: Era era => Term era [GovActionId (EraCrypto era)]
prevProposalOrder :: forall era. Era era => Term era [GovActionId (EraCrypto era)]
prevProposalOrder = 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
"prevProposalOrder" (forall era t. Rep era t -> Rep era [t]
ListR forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR) forall era s t. Access era s t
No

previousCommitteeState ::
  Era era =>
  Term
    era
    ( Map
        (Credential 'ColdCommitteeRole (EraCrypto era))
        (Maybe (Credential 'HotCommitteeRole (EraCrypto era)))
    )
previousCommitteeState :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (Maybe (Credential 'HotCommitteeRole (EraCrypto era))))
previousCommitteeState = 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
"previousCommitteeState" (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 t. Rep era t -> Rep era (Maybe t)
MaybeR forall era.
Era era =>
Rep era (Credential 'HotCommitteeRole (EraCrypto era))
CommHotCredR)) forall era s t. Access era s t
No

commMembers :: Era era => Term era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
commMembers :: forall era.
Era era =>
Term
  era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
commMembers = 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
"commMembers" (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. Rep era EpochNo
EpochR) forall era s t. Access era s t
No

commQuorum :: Era era => Term era UnitInterval
commQuorum :: forall era. Era era => Term era UnitInterval
commQuorum = 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
"commQuorum" forall era. Rep era UnitInterval
UnitIntervalR forall era s t. Access era s t
No

committeeVar :: Era era => Term era (Maybe (Committee era))
committeeVar :: forall era. Era era => Term era (Maybe (Committee era))
committeeVar = 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
"committeeVar" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Era era => Rep era (Committee era)
CommitteeR) forall era s t. Access era s t
No

-- ====================================
-- ConwayGovState Targets

-- ================
-- The DRepPulsingState has two forms
-- 1. DRPulsing
-- 2. DRComplete
-- They both act as Snapshots, storing information from previous epochs
-- DRPulsing stores each 'prevXXX' as a field, and
-- DRComplete stores them in a dedicated datatype PulsingSnapshot

-- | There are 2 forms of DRepPulsingState. This is part of the first one where the pulsing is
--   not complete, and the snapshots are stored as fields in the datatype 'DRepPulser'.
--   Note that the function part of 'Invert' : 'initPulser' makes many transformations from the
--   types used in the Model, and the types stored in the implementation types.
--   In order to construct a valid DRepPulser we need the UTxO (to compute the IncrementalStake)
--   But we cannot find a Lens that can recover the UTxO from a DRepPulser. So we introduce this
--   type ' UtxoPulse' that pairs the two (which makes the recovery possible). W
type UtxoPulse era =
  (Map (TxIn (EraCrypto era)) (TxOutF era), DRepPulser era Identity (RatifyState era))

-- | We also introduce an intermediate variable 'utxoPulse' which can constrain this value
--   by using the predicate [ utxoPulse p :<-: pulsingPair p ]
utxoPulse :: (RunConwayRatify era, Reflect era) => Proof era -> Term era (UtxoPulse era)
utxoPulse :: forall era.
(RunConwayRatify era, Reflect era) =>
Proof era -> Term era (UtxoPulse era)
utxoPulse Proof era
p = 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
"utxoPulse" (forall era t r. Rep era t -> Rep era r -> Rep era (t, r)
PairR (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.
(RunConwayRatify era, Reflect era) =>
Rep era (DRepPulser era Identity (RatifyState era))
DRepPulserR) forall era s t. Access era s t
No

-- | an invertable RootTarget to compute a (UtxoPulse era)
pulsingPairT ::
  forall era.
  (RunConwayRatify era, Reflect era) =>
  Proof era ->
  RootTarget era (UtxoPulse era) (UtxoPulse era)
pulsingPairT :: forall era.
(RunConwayRatify era, Reflect era) =>
Proof era -> RootTarget era (UtxoPulse era) (UtxoPulse era)
pulsingPairT Proof era
proof =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert
    String
"DRepPulser"
    (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(UtxoPulse era))
    (\Map (TxIn StandardCrypto) (TxOutF era)
utx Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
a Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
b Map
  (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
c EpochNo
d Map
  (Credential 'ColdCommitteeRole StandardCrypto)
  (CommitteeAuthorization StandardCrypto)
e EnactState era
f [GovActionState era]
g Map (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
h -> (Map (TxIn StandardCrypto) (TxOutF era)
utx, forall era.
(Reflect era, RunConwayRatify era) =>
Proof era
-> Map (TxIn (EraCrypto era)) (TxOutF era)
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
-> Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> EpochNo
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
-> EnactState era
-> [GovActionState era]
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> DRepPulser era Identity (RatifyState era)
initPulser Proof era
proof Map (TxIn StandardCrypto) (TxOutF era)
utx Map (Credential 'Staking StandardCrypto) (DRep StandardCrypto)
a Map
  (KeyHash 'StakePool StandardCrypto)
  (IndividualPoolStake StandardCrypto)
b Map
  (Credential 'DRepRole StandardCrypto) (DRepState StandardCrypto)
c EpochNo
d Map
  (Credential 'ColdCommitteeRole StandardCrypto)
  (CommitteeAuthorization StandardCrypto)
e EnactState era
f [GovActionState era]
g Map (KeyHash 'StakePool StandardCrypto) (PoolParams StandardCrypto)
h))
    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 (TxIn (EraCrypto era)) (TxOutF era))
utxo Proof era
proof) forall s t a b. Field1 s t a b => Lens s t a b
_1
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegation (forall a. String -> Doc a
ppString String
"prevDRepDelegations") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegationsL)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
poolDistr (forall a. String -> Doc a
ppString String
"prevPoolDistr") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
prevPoolDistrL)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
currentDRepState (forall a. String -> Doc a
ppString String
"prevDRepState") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepStateL)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era. Era era => Term era EpochNo
currentEpoch (forall a. String -> Doc a
ppString String
"prevEpoch") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (DRepPulser era Identity (RatifyState era)) EpochNo
prevEpochL)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
committeeState (forall a. String -> Doc a
ppString String
"prevCommitteeState") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
prevCommitteeStateL)
    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.
Reflect era =>
RootTarget era (EnactState era) (EnactState era)
enactStateT (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens' (DRepPulser era Identity (RatifyState era)) (EnactState era)
prevEnactStateL)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era. Era era => Term era [GovActionState era]
currGovStates (forall a. String -> Doc a
ppString String
"prevProposals") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DRepPulser era Identity (RatifyState era)) [GovActionState era]
ratifyGovActionStatesL)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPools (forall a. String -> Doc a
ppString String
"prevPoolParams") (forall s t a b. Field2 s t a b => Lens s t a b
_2 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
prevRegPoolsL)

-- TODO access prevTreasury from the EnactState
--  :$ Virtual treasury (ppString "prevTreasury") (_2 . prevTreasuryL)

justPulser ::
  forall era.
  (Reflect era, RunConwayRatify era) =>
  Proof era ->
  RootTarget
    era
    (DRepPulser era Identity (RatifyState era))
    (DRepPulser era Identity (RatifyState era))
justPulser :: forall era.
(Reflect era, RunConwayRatify era) =>
Proof era
-> RootTarget
     era
     (DRepPulser era Identity (RatifyState era))
     (DRepPulser era Identity (RatifyState era))
justPulser Proof era
p =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"DRepPulser" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(DRepPulser era Identity (RatifyState era))) (forall era.
(Reflect era, RunConwayRatify era) =>
Proof era
-> Map (TxIn (EraCrypto era)) (TxOutF era)
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
-> Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> EpochNo
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
-> EnactState era
-> [GovActionState era]
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> DRepPulser era Identity (RatifyState era)
initPulser Proof era
p forall k a. Map k a
Map.empty)
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
drepDelegation (forall a. String -> Doc a
ppString String
"prevDRepDelegations") forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegationsL
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
poolDistr (forall a. String -> Doc a
ppString String
"prevPoolDistr") forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
prevPoolDistrL
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
currentDRepState (forall a. String -> Doc a
ppString String
"prevDRepState") forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepStateL
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era. Era era => Term era EpochNo
currentEpoch (forall a. String -> Doc a
ppString String
"prevEpoch") forall era.
Lens' (DRepPulser era Identity (RatifyState era)) EpochNo
prevEpochL
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
committeeState (forall a. String -> Doc a
ppString String
"prevCommitteeState") forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
prevCommitteeStateL
    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.
Reflect era =>
RootTarget era (EnactState era) (EnactState era)
enactStateT forall era.
Lens' (DRepPulser era Identity (RatifyState era)) (EnactState era)
prevEnactStateL
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era. Era era => Term era [GovActionState era]
currGovStates (forall a. String -> Doc a
ppString String
"prevProposals") forall era.
Lens'
  (DRepPulser era Identity (RatifyState era)) [GovActionState era]
ratifyGovActionStatesL
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
regPools (forall a. String -> Doc a
ppString String
"prevPoolParams") forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
prevRegPoolsL

-- TODO access prevTreasury from the EnactState
-- :$ Virtual treasury (ppString "prevTreasury") (prevTreasuryL)

-- | Variable used to constrain the DRepPulser
drepPulser ::
  (RunConwayRatify era, Reflect era) => Term era (DRepPulser era Identity (RatifyState era))
drepPulser :: forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser = 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
"drepPulser" forall era.
(RunConwayRatify era, Reflect era) =>
Rep era (DRepPulser era Identity (RatifyState era))
DRepPulserR forall era s t. Access era s t
No

-- | Predicates that constrain the DRepPuser and all its 'prevXXX' snapshots
--   These ensure we generate state just passing the epoch boundary
prevPulsingPreds :: (RunConwayRatify era, Reflect era) => Proof era -> [Pred era]
prevPulsingPreds :: forall era.
(RunConwayRatify era, Reflect era) =>
Proof era -> [Pred era]
prevPulsingPreds Proof era
p =
  [ forall t era. Sizeable t => Term era Size -> Term era t -> Pred era
Sized (forall era. Era era => Int -> Term era Size
ExactSize Int
0) (forall t era r. Ord t => Term era (Map t r) -> Term era (Set t)
Dom forall era.
Era era =>
Term era (Map (Credential 'Staking (EraCrypto era)) Coin)
enactWithdrawals)
  , forall era t. Rep era t -> t -> Term era t
Lit forall era. Rep era Coin
CoinR (Integer -> Coin
Coin Integer
0) forall t era. Eq t => Term era t -> Term era t -> Pred era
:=: forall era. Era era => Term era Coin
enactTreasury
  , forall era.
(RunConwayRatify era, Reflect era) =>
Proof era -> Term era (UtxoPulse era)
utxoPulse Proof era
p forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: forall era.
(RunConwayRatify era, Reflect era) =>
Proof era -> RootTarget era (UtxoPulse era) (UtxoPulse era)
pulsingPairT Proof era
p
  , forall era. Reflect era => Term era (GovRelation StrictMaybe era)
prevGovActionIds
      forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: ( forall t r era. String -> (t -> r) -> RootTarget era Void (t -> r)
Constr String
"PrevGovActionIdsFromProposals" (\Proposals era
cp -> forall era. GovRelation PRoot era -> GovRelation StrictMaybe era
toPrevGovActionIds (Proposals era
cp forall s a. s -> Getting a s a -> a
^. forall era. Lens' (Proposals era) (GovRelation PRoot era)
pRootsL))
              forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ (forall era. Era era => Proof era -> Term era (Proposals era)
currProposals Proof era
p)
           )
  , forall era. Era era => Term era [GovActionState era]
currGovStates forall era t r. Term era t -> RootTarget era r t -> Pred era
:<-: (forall t r era. String -> (t -> r) -> RootTarget era Void (t -> r)
Constr String
"proposalsActions" (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proposals era -> StrictSeq (GovActionState era)
proposalsActions) forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ forall era. Era era => Proof era -> Term era (Proposals era)
currProposals Proof era
p)
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser (forall era.
(RunConwayRatify era, Reflect era) =>
Proof era -> Term era (UtxoPulse era)
utxoPulse Proof era
p) forall s t a b. Field2 s t a b => Lens s t a b
_2
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era. Era era => Term era (Map (DRep (EraCrypto era)) Coin)
partialDRepDistr forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map (DRep (EraCrypto era)) Coin)
partialDRepDistrL
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era.
Era era =>
Term
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegations forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegationsL
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
prevPoolDistr forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
prevPoolDistrL
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era.
Era era =>
Term
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepState forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepStateL
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era. Era era => Term era EpochNo
prevEpoch forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens' (DRepPulser era Identity (RatifyState era)) EpochNo
prevEpochL
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era.
Era era =>
Term
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
prevCommitteeState forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
prevCommitteeStateL
  , forall t era big.
(Eq t, Era era) =>
Term era t -> Term era big -> Lens' big t -> Pred era
select forall era. Reflect era => Term era (EnactState era)
prevEnactState forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser forall era.
Lens' (DRepPulser era Identity (RatifyState era)) (EnactState era)
prevEnactStateL
  , forall era. Era era => Proof era -> Term era (Proposals era)
currProposals Proof era
p forall t era. Eq t => Term era t -> Term era t -> Pred era
:=: forall era. Era era => Proof era -> Term era (Proposals era)
prevProposals Proof era
p
  -- TODO access prevTreasury from the EnactState
  -- , select prevTreasury drepPulser prevTreasuryL
  ]

-- | Target for assembling 'DRPulsing' form of (DRepPulsingState era)
--   from 'drepPulser' :: forall era. Term era (DRepPulser era Identity (RatifyState era))
pulsingPulsingStateT ::
  forall era.
  (RunConwayRatify era, Reflect era) =>
  RootTarget era (DRepPulsingState era) (DRepPulsingState era)
pulsingPulsingStateT :: forall era.
(RunConwayRatify era, Reflect era) =>
RootTarget era (DRepPulsingState era) (DRepPulsingState era)
pulsingPulsingStateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"DRPulsing" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(DRepPulsingState era)) forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing
    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 -> PDoc -> Lens' root t -> RootTarget era root t
Virtual forall era.
(RunConwayRatify era, Reflect era) =>
Term era (DRepPulser era Identity (RatifyState era))
drepPulser (forall era r t. RootTarget era r t -> PDoc
ppTarget (forall era.
(Reflect era, RunConwayRatify era) =>
Proof era
-> RootTarget
     era
     (DRepPulser era Identity (RatifyState era))
     (DRepPulser era Identity (RatifyState era))
justPulser @era forall era. Reflect era => Proof era
reify)) forall era.
Lens'
  (DRepPulsingState era) (DRepPulser era Identity (RatifyState era))
pulsingStatePulserL

-- | The Lens' used in pulsingPulsingStateT
pulsingStatePulserL :: Lens' (DRepPulsingState era) (DRepPulser era Identity (RatifyState era))
pulsingStatePulserL :: forall era.
Lens'
  (DRepPulsingState era) (DRepPulser era Identity (RatifyState era))
pulsingStatePulserL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {era}.
DRepPulsingState era -> DRepPulser era Identity (RatifyState era)
getter forall {era} {era}.
DRepPulsingState era
-> DRepPulser era Identity (RatifyState era)
-> DRepPulsingState era
setter
  where
    getter :: DRepPulsingState era -> DRepPulser era Identity (RatifyState era)
getter (DRPulsing DRepPulser era Identity (RatifyState era)
x) = DRepPulser era Identity (RatifyState era)
x
    getter (DRComplete PulsingSnapshot era
_ RatifyState era
_) =
      forall a. HasCallStack => String -> a
error (String
"Can't turn a DRCompete into a DRPulsing in pulsingStatePulserL lens.")
    {- There is a way we could do this, by partitioning the prev parts of 'DRPulsing' into
       3 parts RatifyState, RatifySignal, and RatifyEnv, and then making Store those 3
       instead of storing a single PulsingSnapshot. Then we could reassemble a DRPulsing
       that was ready for completion.
    -}
    setter :: DRepPulsingState era
-> DRepPulser era Identity (RatifyState era)
-> DRepPulsingState era
setter (DRPulsing DRepPulser era Identity (RatifyState era)
_) DRepPulser era Identity (RatifyState era)
x = forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x
    setter (DRComplete PulsingSnapshot era
_ RatifyState era
_) DRepPulser era Identity (RatifyState era)
x = forall era.
DRepPulser era Identity (RatifyState era) -> DRepPulsingState era
DRPulsing DRepPulser era Identity (RatifyState era)
x

-- | The abstract form of DRepPulser that transforms from the Model types
--   used in the inputs, and the concrete types actually stored in 'DRepPulser'
initPulser ::
  forall era.
  (Reflect era, RunConwayRatify era) =>
  Proof era ->
  Map (TxIn (EraCrypto era)) (TxOutF era) ->
  Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)) ->
  Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)) ->
  Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)) ->
  EpochNo ->
  Map (Credential 'ColdCommitteeRole (EraCrypto era)) (CommitteeAuthorization (EraCrypto era)) ->
  EnactState era ->
  [GovActionState era] ->
  -- Coin ->
  Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)) ->
  DRepPulser era Identity (RatifyState era)
initPulser :: forall era.
(Reflect era, RunConwayRatify era) =>
Proof era
-> Map (TxIn (EraCrypto era)) (TxOutF era)
-> Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
-> Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era))
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> EpochNo
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
-> EnactState era
-> [GovActionState era]
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> DRepPulser era Identity (RatifyState era)
initPulser Proof era
proof Map (TxIn (EraCrypto era)) (TxOutF era)
utx Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
credDRepMap Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
poold Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
credDRepStateMap EpochNo
epoch Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
commstate EnactState era
enactstate [GovActionState era]
govstates {- treas -} Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams =
  let umap :: UMap StandardCrypto
umap = forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty forall k a. Map k a
Map.empty Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
credDRepMap
      umapSize :: Int
umapSize = forall k a. Map k a -> Int
Map.size Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
credDRepMap
      k :: Word64
k = Globals -> Word64
securityParameter Globals
testGlobals
      pp :: PParams era
      pp :: PParams era
pp = forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era. EraPParams era => Lens' (PParams era) ProtVer
ppProtocolVersionL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall era. Proof era -> ProtVer
protocolVersion Proof era
proof
      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 PParams era
pp forall a. Monoid a => a
mempty forall a. Monoid a => a
mempty (Map (TxIn (EraCrypto era)) (TxOutF era)
utx forall s a. s -> Getting a s a -> a
^. forall era.
Proof era
-> Lens' (Map (TxIn (EraCrypto era)) (TxOutF era)) (UTxO era)
utxoFL Proof era
proof)
   in forall era ans (m :: * -> *).
(ans ~ RatifyState era, m ~ Identity, RunConwayRatify era) =>
Int
-> UMap (EraCrypto era)
-> Int
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> PoolDistr (EraCrypto era)
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> EpochNo
-> CommitteeState era
-> EnactState era
-> StrictSeq (GovActionState era)
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
-> Globals
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
-> DRepPulser era m ans
DRepPulser
        (forall a. Ord a => a -> a -> a
max Int
1 (forall a b. (RealFrac a, Integral b) => a -> b
ceiling (forall a. Integral a => a -> Integer
toInteger Int
umapSize forall a. Integral a => a -> a -> Ratio a
% (Integer
8 forall a. Num a => a -> a -> a
* forall a. Integral a => a -> Integer
toInteger Word64
k))))
        UMap StandardCrypto
umap
        Int
0
        Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
stakeDistr
        (forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
poold forall a b. (a -> b) -> a -> b
$ Word64 -> CompactForm Coin
CompactCoin Word64
1)
        forall k a. Map k a
Map.empty
        Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
credDRepStateMap
        EpochNo
epoch
        (forall era.
Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
-> CommitteeState era
CommitteeState Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
commstate)
        EnactState era
enactstate
        (forall a. [a] -> StrictSeq a
SS.fromList [GovActionState era]
govstates)
        (forall era.
Proposals era
-> Map (Credential 'Staking (EraCrypto era)) (CompactForm Coin)
proposalsDeposits forall a b. (a -> b) -> a -> b
$ forall a. Default a => a
def forall a b. a -> (a -> b) -> b
& forall era.
Lens'
  (Proposals era)
  (OMap (GovActionId (EraCrypto era)) (GovActionState era))
pPropsL forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall (f :: * -> *) k v.
(Foldable f, HasOKey k v) =>
f v -> OMap k v
OMap.fromFoldable [GovActionState era]
govstates)
        -- treas
        Globals
testGlobals
        Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
poolParams

proposalsT :: forall era. Era era => Proof era -> RootTarget era (Proposals era) (Proposals era)
proposalsT :: forall era.
Era era =>
Proof era -> RootTarget era (Proposals era) (Proposals era)
proposalsT Proof era
proof =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"Proposals" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(Proposals era)) forall a. a -> a
id
    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 (Proposals era)
currProposals Proof era
proof) (forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall a. a -> a
id forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id)

-- ==================================================
-- Second form of DRepPulsingState 'DRComplete'
-- ==================================================

-- | The snapshot dedicated datatype (PulsingSnapshot era) stored inside 'DRComplete'
--   Note this is used in 'dRepPulsingStateT', the second  DRepPulsingState form.
pulsingSnapshotT ::
  forall era. Era era => RootTarget era (PulsingSnapshot era) (PulsingSnapshot era)
pulsingSnapshotT :: forall era.
Era era =>
RootTarget era (PulsingSnapshot era) (PulsingSnapshot era)
pulsingSnapshotT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert
    String
"PulsingSnapshot"
    (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(PulsingSnapshot era))
    ( \[GovActionState era]
a Map (DRep (EraCrypto era)) Coin
b Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
c Map (KeyHash 'StakePool (EraCrypto era)) Coin
d -> forall era.
StrictSeq (GovActionState era)
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
-> Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin)
-> PulsingSnapshot era
PulsingSnapshot (forall a. [a] -> StrictSeq a
SS.fromList [GovActionState era]
a) (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (DRep (EraCrypto era)) Coin
b) Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
c (forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (KeyHash 'StakePool (EraCrypto era)) Coin
d)
    )
    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 [GovActionState era]
currGovStates (forall era.
Lens' (PulsingSnapshot era) (StrictSeq (GovActionState era))
psProposalsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (StrictSeq a) [a]
strictSeqListL)
    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 (DRep (EraCrypto era)) Coin)
partialDRepDistr (forall era.
Lens'
  (PulsingSnapshot era)
  (Map (DRep (EraCrypto era)) (CompactForm Coin))
psDRepDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Map a (CompactForm Coin)) (Map a Coin)
mapCompactFormCoinL)
    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 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepState forall era.
Lens'
  (PulsingSnapshot era)
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
psDRepStateL
    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)) Coin)
partialIndividualPoolStake (forall era.
Lens'
  (PulsingSnapshot era)
  (Map (KeyHash 'StakePool (EraCrypto era)) (CompactForm Coin))
psPoolDistrL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Lens' (Map a (CompactForm Coin)) (Map a Coin)
mapCompactFormCoinL)

pulsingSnapshotL :: Lens' (DRepPulsingState era) (PulsingSnapshot era)
pulsingSnapshotL :: forall era. Lens' (DRepPulsingState era) (PulsingSnapshot era)
pulsingSnapshotL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {era}. DRepPulsingState era -> PulsingSnapshot era
getter forall {era}.
DRepPulsingState era -> PulsingSnapshot era -> DRepPulsingState era
setter
  where
    getter :: DRepPulsingState era -> PulsingSnapshot era
getter (DRComplete PulsingSnapshot era
x RatifyState era
_) = PulsingSnapshot era
x
    getter DRepPulsingState era
other = forall a b. (a, b) -> a
fst (forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
other)
    setter :: DRepPulsingState era -> PulsingSnapshot era -> DRepPulsingState era
setter (DRComplete PulsingSnapshot era
_ RatifyState era
y) PulsingSnapshot era
x = forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
x RatifyState era
y
    setter DRepPulsingState era
other PulsingSnapshot era
x = forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
x RatifyState era
y
      where
        (PulsingSnapshot era
_, RatifyState era
y) = forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
other

-- | There are 2 forms of DRepPulsingState. This is the second one
--   where the pulsing is complete
completePulsingStateT ::
  forall era.
  Reflect era =>
  Proof era ->
  RootTarget era (DRepPulsingState era) (DRepPulsingState era)
completePulsingStateT :: forall era.
Reflect era =>
Proof era
-> RootTarget era (DRepPulsingState era) (DRepPulsingState era)
completePulsingStateT Proof era
_p =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"DRComplete" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(DRepPulsingState era)) forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete
    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 (PulsingSnapshot era) (PulsingSnapshot era)
pulsingSnapshotT forall era. Lens' (DRepPulsingState era) (PulsingSnapshot era)
pulsingSnapshotL
    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. Reflect era => Term era (RatifyState era)
ratifyState forall era. Lens' (DRepPulsingState era) (RatifyState era)
ratifyStateL

ratifyState :: Reflect era => Term era (RatifyState era)
ratifyState :: forall era. Reflect era => Term era (RatifyState era)
ratifyState = 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
"ratifyState" forall era. Reflect era => Rep era (RatifyState era)
RatifyStateR forall era s t. Access era s t
No

ratifyStateL :: Lens' (DRepPulsingState era) (RatifyState era)
ratifyStateL :: forall era. Lens' (DRepPulsingState era) (RatifyState era)
ratifyStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {era}. DRepPulsingState era -> RatifyState era
getter forall {era}.
DRepPulsingState era -> RatifyState era -> DRepPulsingState era
setter
  where
    getter :: DRepPulsingState era -> RatifyState era
getter (DRComplete PulsingSnapshot era
_ RatifyState era
y) = RatifyState era
y
    getter (x :: DRepPulsingState era
x@(DRPulsing {})) = forall a b. (a, b) -> b
snd (forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
x)
    setter :: DRepPulsingState era -> RatifyState era -> DRepPulsingState era
setter (DRComplete PulsingSnapshot era
x RatifyState era
_) RatifyState era
y = forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
x RatifyState era
y
    setter (z :: DRepPulsingState era
z@(DRPulsing {})) RatifyState era
y = case forall era.
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser DRepPulsingState era
z of
      (PulsingSnapshot era
x, RatifyState era
_) -> forall era.
PulsingSnapshot era -> RatifyState era -> DRepPulsingState era
DRComplete PulsingSnapshot era
x RatifyState era
y

prevProposals :: Era era => Proof era -> Term era (Proposals era)
prevProposals :: forall era. Era era => Proof era -> Term era (Proposals era)
prevProposals Proof era
p = 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
"prevProposals" (forall era. Era era => Proof era -> Rep era (Proposals era)
ProposalsR Proof era
p) forall era s t. Access era s t
No

ratifyGovActionStatesL :: Lens' (DRepPulser era Identity (RatifyState era)) [GovActionState era]
ratifyGovActionStatesL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era)) [GovActionState era]
ratifyGovActionStatesL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\DRepPulser era Identity (RatifyState era)
x -> forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList (forall era ans (m :: * -> *).
DRepPulser era m ans -> StrictSeq (GovActionState era)
dpProposals DRepPulser era Identity (RatifyState era)
x))
    (\DRepPulser era Identity (RatifyState era)
x [GovActionState era]
y -> DRepPulser era Identity (RatifyState era)
x {dpProposals :: StrictSeq (GovActionState era)
dpProposals = forall a. [a] -> StrictSeq a
SS.fromList [GovActionState era]
y})

-- | Partially computed DRepDistr inside the pulser
partialDRepDistr :: Era era => Term era (Map (DRep (EraCrypto era)) Coin)
partialDRepDistr :: forall era. Era era => Term era (Map (DRep (EraCrypto era)) Coin)
partialDRepDistr = 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
"partialDRepDistr" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (DRep (EraCrypto era))
DRepR forall era. Rep era Coin
CoinR) forall era s t. Access era s t
No

partialDRepDistrL ::
  Lens' (DRepPulser era Identity (RatifyState era)) (Map (DRep (EraCrypto era)) Coin)
partialDRepDistrL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map (DRep (EraCrypto era)) Coin)
partialDRepDistrL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\DRepPulser era Identity (RatifyState era)
x -> forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall a. Compactible a => CompactForm a -> a
fromCompact (forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepDistr DRepPulser era Identity (RatifyState era)
x))
    (\DRepPulser era Identity (RatifyState era)
x Map (DRep (EraCrypto era)) Coin
y -> DRepPulser era Identity (RatifyState era)
x {dpDRepDistr :: Map (DRep (EraCrypto era)) (CompactForm Coin)
dpDRepDistr = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (DRep (EraCrypto era)) Coin
y})

-- | Snapshot of 'dreps' from the start of the current epoch
prevDRepState ::
  Era era => Term era (Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepState :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepState = 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
"prevDRepState" (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. Access era s t
No

prevDRepStateL ::
  Lens'
    (DRepPulser era Identity (RatifyState era))
    (Map (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepStateL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era)))
prevDRepStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState (\DRepPulser era Identity (RatifyState era)
x Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
y -> DRepPulser era Identity (RatifyState era)
x {dpDRepState :: Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
dpDRepState = Map
  (Credential 'DRepRole (EraCrypto era)) (DRepState (EraCrypto era))
y})

-- | snapshot of 'poolDistr' from the start of the current epoch
prevPoolDistr ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
prevPoolDistr :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
prevPoolDistr = 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
"prevPoolDistr" (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

prevPoolDistrL ::
  Lens'
    (DRepPulser era Identity (RatifyState era))
    (Map (KeyHash 'StakePool (EraCrypto era)) (IndividualPoolStake (EraCrypto era)))
prevPoolDistrL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era))
     (IndividualPoolStake (EraCrypto era)))
prevPoolDistrL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\DRepPulser era Identity (RatifyState era)
x -> forall c.
PoolDistr c -> Map (KeyHash 'StakePool c) (IndividualPoolStake c)
unPoolDistr (forall era ans (m :: * -> *).
DRepPulser era m ans -> PoolDistr (EraCrypto era)
dpStakePoolDistr DRepPulser era Identity (RatifyState era)
x))
    (\DRepPulser era Identity (RatifyState era)
x Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
y -> DRepPulser era Identity (RatifyState era)
x {dpStakePoolDistr :: PoolDistr (EraCrypto era)
dpStakePoolDistr = forall c.
Map (KeyHash 'StakePool c) (IndividualPoolStake c)
-> CompactForm Coin -> PoolDistr c
PoolDistr Map
  (KeyHash 'StakePool (EraCrypto era))
  (IndividualPoolStake (EraCrypto era))
y forall a b. (a -> b) -> a -> b
$ Word64 -> CompactForm Coin
CompactCoin Word64
1})

-- | Snapshot of the 'drepDelegation' from he start of the current epoch.
prevDRepDelegations ::
  Era era => Term era (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegations :: forall era.
Era era =>
Term
  era
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegations = 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
"prevDRepDelegations" (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. Access era s t
No

-- | Snapshot of 'drepDelegation' from the start of the current epoch
prevDRepDelegationsL ::
  Lens'
    (DRepPulser era Identity (RatifyState era))
    (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegationsL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era)))
prevDRepDelegationsL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\DRepPulser era Identity (RatifyState era)
x -> forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpUMap DRepPulser era Identity (RatifyState era)
x forall s a. s -> Getting a s a -> a
^. forall c. Lens' (UMap c) (Map (Credential 'Staking c) (DRep c))
drepUMapL)
    ( \DRepPulser era Identity (RatifyState era)
x Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
y ->
        DRepPulser era Identity (RatifyState era)
x
          { dpUMap :: UMap (EraCrypto era)
dpUMap =
              forall c.
Map (Credential 'Staking c) RDPair
-> Map Ptr (Credential 'Staking c)
-> Map (Credential 'Staking c) (KeyHash 'StakePool c)
-> Map (Credential 'Staking c) (DRep c)
-> UMap c
unify
                (forall c. UMap c -> Map (Credential 'Staking c) RDPair
rdPairMap (forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpUMap DRepPulser era Identity (RatifyState era)
x))
                (forall c. UMap c -> Map Ptr (Credential 'Staking c)
ptrMap (forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpUMap DRepPulser era Identity (RatifyState era)
x))
                (forall c.
UMap c -> Map (Credential 'Staking c) (KeyHash 'StakePool c)
sPoolMap (forall era ans (m :: * -> *).
DRepPulser era m ans -> UMap (EraCrypto era)
dpUMap DRepPulser era Identity (RatifyState era)
x))
                Map (Credential 'Staking (EraCrypto era)) (DRep (EraCrypto era))
y
          }
    )

-- | Snapshot of 'committeeState' from the start of the current epoch
prevCommitteeState ::
  Era era =>
  Term
    era
    (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (CommitteeAuthorization (EraCrypto era)))
prevCommitteeState :: forall era.
Era era =>
Term
  era
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
prevCommitteeState = 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
"prevCommitteeState" (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. Access era s t
No

prevCommitteeStateL ::
  Lens'
    (DRepPulser era Identity (RatifyState era))
    (Map (Credential 'ColdCommitteeRole (EraCrypto era)) (CommitteeAuthorization (EraCrypto era)))
prevCommitteeStateL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era)))
prevCommitteeStateL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (forall era.
CommitteeState era
-> Map
     (Credential 'ColdCommitteeRole (EraCrypto era))
     (CommitteeAuthorization (EraCrypto era))
csCommitteeCreds forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era ans (m :: * -> *).
DRepPulser era m ans -> CommitteeState era
dpCommitteeState)
    (\DRepPulser era Identity (RatifyState era)
x Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
y -> DRepPulser era Identity (RatifyState era)
x {dpCommitteeState :: CommitteeState era
dpCommitteeState = forall era.
Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
-> CommitteeState era
CommitteeState Map
  (Credential 'ColdCommitteeRole (EraCrypto era))
  (CommitteeAuthorization (EraCrypto era))
y})

-- | Snapshot of the enactState built by 'enactStateT' assembled from data at the start the current epoch
prevEnactState :: Reflect era => Term era (EnactState era)
prevEnactState :: forall era. Reflect era => Term era (EnactState era)
prevEnactState = 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
"prevEnactState" forall era. Reflect era => Rep era (EnactState era)
EnactStateR forall era s t. Access era s t
No

prevEnactStateL :: Lens' (DRepPulser era Identity (RatifyState era)) (EnactState era)
prevEnactStateL :: forall era.
Lens' (DRepPulser era Identity (RatifyState era)) (EnactState era)
prevEnactStateL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era ans (m :: * -> *).
DRepPulser era m ans -> EnactState era
dpEnactState (\DRepPulser era Identity (RatifyState era)
x EnactState era
y -> DRepPulser era Identity (RatifyState era)
x {dpEnactState :: EnactState era
dpEnactState = EnactState era
y})

-- | Snapshot of 'currentEpoch' just before the start of the current epoch. (currenEpoch - 1)
prevEpoch :: Era era => Term era EpochNo
prevEpoch :: forall era. Era era => Term era EpochNo
prevEpoch = 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
"prevEpoch" forall era. Rep era EpochNo
EpochR forall era s t. Access era s t
No

prevEpochL :: Lens' (DRepPulser era Identity (RatifyState era)) EpochNo
prevEpochL :: forall era.
Lens' (DRepPulser era Identity (RatifyState era)) EpochNo
prevEpochL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall era ans (m :: * -> *). DRepPulser era m ans -> EpochNo
dpCurrentEpoch (\DRepPulser era Identity (RatifyState era)
x EpochNo
y -> DRepPulser era Identity (RatifyState era)
x {dpCurrentEpoch :: EpochNo
dpCurrentEpoch = EpochNo
y})

prevTreasury :: Era era => Term era Coin
prevTreasury :: forall era. Era era => Term era Coin
prevTreasury = 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
"prevTreasury" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No

{-
-- TODO access prevTreasury from the EnactState
prevTreasuryL :: Lens' (DRepPulser era Identity (RatifyState era)) Coin
prevTreasuryL = lens dpTreasury (\x y -> x {dpTreasury = y})
-}

partialIndividualPoolStake :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
partialIndividualPoolStake :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) Coin)
partialIndividualPoolStake = 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
"partialIndividualPoolStake" (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. Access era s t
No

prevRegPools ::
  Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
prevRegPools :: forall era.
Era era =>
Term
  era
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
prevRegPools = 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
"prevRegPools" (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. Access era s t
No

prevRegPoolsL ::
  Lens'
    (DRepPulser era Identity (RatifyState era))
    (Map (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
prevRegPoolsL :: forall era.
Lens'
  (DRepPulser era Identity (RatifyState era))
  (Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era)))
prevRegPoolsL =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    forall era ans (m :: * -> *).
DRepPulser era m ans
-> Map
     (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpPoolParams
    (\DRepPulser era Identity (RatifyState era)
x Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
y -> DRepPulser era Identity (RatifyState era)
x {dpPoolParams :: Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
dpPoolParams = Map
  (KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
y})

-- ======================================
-- ConwayGovState

conwayGovStateT ::
  forall era.
  (RunConwayRatify era, Reflect era) =>
  Proof era ->
  RootTarget era (ConwayGovState era) (ConwayGovState era)
conwayGovStateT :: forall era.
(RunConwayRatify era, Reflect era) =>
Proof era
-> RootTarget era (ConwayGovState era) (ConwayGovState era)
conwayGovStateT Proof era
p =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert
    String
"ConwayGovState"
    (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(ConwayGovState era))
    ( \Proposals era
pr Maybe (Committee era)
com Constitution era
con (PParamsF Proof era
_ PParams era
cpp) (PParamsF Proof era
_ PParams era
ppp) FuturePParams era
pu -> forall era.
Proposals era
-> StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> FuturePParams era
-> DRepPulsingState era
-> ConwayGovState era
ConwayGovState Proposals era
pr (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Committee era)
com) Constitution era
con PParams era
cpp PParams era
ppp FuturePParams era
pu
    )
    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 (Proposals era)
currProposals Proof era
p) forall era. Lens' (ConwayGovState era) (Proposals era)
cgsProposalsL
    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 (Maybe (Committee era))
committeeVar (forall era.
Lens' (ConwayGovState era) (StrictMaybe (Committee era))
cgsCommitteeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (StrictMaybe x) (Maybe x)
strictMaybeToMaybeL) -- see 'committeeT' to construct a binding for committeeVar
    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 (Constitution era)
constitution forall era. Lens' (ConwayGovState era) (Constitution era)
cgsConstitutionL
    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 forall era. Reflect era => Proof era
reify) (forall era. Lens' (ConwayGovState era) (PParams era)
cgsCurPParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL forall era. Reflect era => Proof era
reify)
    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 forall era. Reflect era => Proof era
reify) (forall era. Lens' (ConwayGovState era) (PParams era)
cgsPrevPParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL forall era. Reflect era => Proof era
reify)
    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 forall era. Reflect era => Proof era
reify) forall era. Lens' (ConwayGovState era) (FuturePParams era)
cgsFuturePParamsL
    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.
(RunConwayRatify era, Reflect era) =>
RootTarget era (DRepPulsingState era) (DRepPulsingState era)
pulsingPulsingStateT forall era. Lens' (ConwayGovState era) (DRepPulsingState era)
cgsDRepPulsingStateL

-- | The sum of all the 'gasDeposit' fields of 'currProposals'
proposalDeposits :: Era era => Term era Coin
proposalDeposits :: forall era. Era era => Term era Coin
proposalDeposits = 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
"proposalDeposits" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

-- | A view of 'currentDRepState' (sum of the drepDeposit field of in the range of 'currentDRepState')
drepDepositsView :: Era era => Term era (Map (Credential 'DRepRole (EraCrypto era)) Coin)
drepDepositsView :: forall era.
Era era =>
Term era (Map (Credential 'DRepRole (EraCrypto era)) Coin)
drepDepositsView = 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
"drepDepositsView" (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. Rep era Coin
CoinR) forall era s t. Access era s t
No)

-- | The current set of proposals. Proposals has a serious set of invariants.
--   We do not attempt to state these proposals (Yes I know that is cheating)
--   We get random Proposals (that meets its invariants) by using (genSizedRep n (ProposalsR p))
currProposals :: Era era => Proof era -> Term era (Proposals era)
currProposals :: forall era. Era era => Proof era -> Term era (Proposals era)
currProposals Proof era
p = 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
"currProposals" (forall era. Era era => Proof era -> Rep era (Proposals era)
ProposalsR Proof era
p) forall era s t. Access era s t
No

-- | Part of the EnactState, it is computed by selecting from currProposals
prevGovActionIds :: forall era. Reflect era => Term era (GovRelation StrictMaybe era)
prevGovActionIds :: forall era. Reflect era => Term era (GovRelation StrictMaybe era)
prevGovActionIds = 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
"prevGovActionIds" forall era. Era era => Rep era (GovRelation StrictMaybe era)
PrevGovActionIdsR forall era s t. Access era s t
No

-- | This is a view of currProposals, so will compute it once
--   once currProposals is defined
currGovStates :: Era era => Term era [GovActionState era]
currGovStates :: forall era. Era era => Term era [GovActionState era]
currGovStates = 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
"currGovStates" (forall era t. Rep era t -> Rep era [t]
ListR forall era. Era era => Rep era (GovActionState era)
GovActionStateR) forall era s t. Access era s t
No)

enactStateT :: forall era. Reflect era => RootTarget era (EnactState era) (EnactState era)
enactStateT :: forall era.
Reflect era =>
RootTarget era (EnactState era) (EnactState era)
enactStateT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert
    String
"EnactState"
    (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(EnactState era))
    (\Maybe (Committee era)
x Constitution era
y (PParamsF Proof era
_ PParams era
z) (PParamsF Proof era
_ PParams era
w) Coin
a Map (Credential 'Staking StandardCrypto) Coin
b GovRelation StrictMaybe era
c -> forall era.
StrictMaybe (Committee era)
-> Constitution era
-> PParams era
-> PParams era
-> Coin
-> Map (Credential 'Staking (EraCrypto era)) Coin
-> GovRelation StrictMaybe era
-> EnactState era
EnactState (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (Committee era)
x) Constitution era
y PParams era
z PParams era
w Coin
a Map (Credential 'Staking StandardCrypto) Coin
b GovRelation StrictMaybe era
c)
    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 (Maybe (Committee era))
committeeVar (forall era. Lens' (EnactState era) (StrictMaybe (Committee era))
ensCommitteeL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (StrictMaybe x) (Maybe x)
strictMaybeToMaybeL) -- see 'committeeT' to construct a binding for committeeVar
    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 (Constitution era)
constitution forall era. Lens' (EnactState era) (Constitution era)
ensConstitutionL
    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 forall era. Reflect era => Proof era
reify) (forall era. Lens' (EnactState era) (PParams era)
ensCurPParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL forall era. Reflect era => Proof era
reify)
    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 forall era. Reflect era => Proof era
reify) (forall era. Lens' (EnactState era) (PParams era)
ensPrevPParamsL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL forall era. Reflect era => Proof era
reify)
    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
enactTreasury forall era. Lens' (EnactState era) Coin
ensTreasuryL
    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)
enactWithdrawals forall era.
Lens'
  (EnactState era) (Map (Credential 'Staking (EraCrypto era)) Coin)
ensWithdrawalsL
    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. Reflect era => Term era (GovRelation StrictMaybe era)
prevGovActionIds forall era. Lens' (EnactState era) (GovRelation StrictMaybe era)
ensPrevGovActionIdsL

-- | One can use this Target, to make a constraint for 'committeeVar' from the
--   vars 'commMembers' and 'commQuorum'
committeeT :: forall era. Era era => RootTarget era (Committee era) (Committee era)
committeeT :: forall era.
Era era =>
RootTarget era (Committee era) (Committee era)
committeeT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"Committee" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(Committee era)) forall era.
Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval -> Committee era
Committee
    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 'ColdCommitteeRole (EraCrypto era)) EpochNo)
commMembers forall era.
Lens'
  (Committee era)
  (Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
committeeMembersL
    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 UnitInterval
commQuorum forall era. Lens' (Committee era) UnitInterval
committeeThresholdL

{-
prevGovActionIdsT =
  Invert
    "prevGovActionIds"
    (typeRep @(PrevGovActionIds era))
    (\w x y z -> PrevGovActionIds $ PForest (maybeToStrictMaybe w) (maybeToStrictMaybe x) (maybeToStrictMaybe y) (maybeToStrictMaybe z))
    :$ Lensed prevPParamUpdate (prevGovActionIdsL . pfPParamUpdateL . strictMaybeToMaybeL)
    :$ Lensed prevHardFork (prevGovActionIdsL . pfHardForkL . strictMaybeToMaybeL)
    :$ Lensed prevCommittee (prevGovActionIdsL . pfCommitteeL . strictMaybeToMaybeL)
    :$ Lensed prevConstitution (prevGovActionIdsL . pfConstitutionL . strictMaybeToMaybeL)

prevPParamUpdate :: Era era => Term era (Maybe (GovPurposeId 'PParamUpdatePurpose era))
prevPParamUpdate = Var $ V "prevPParamUpdate" (MaybeR PrevPParamUpdateR) No

prevHardFork :: Era era => Term era (Maybe (GovPurposeId 'HardForkPurpose era))
prevHardFork = Var $ V "prevHardFork" (MaybeR PrevHardForkR) No

-- | Snapshot of 'committeeState' from the start of the current epoch
prevCommittee :: Era era => Term era (Maybe (GovPurposeId 'CommitteePurpose era))
prevCommittee = Var $ V "prevCommittee" (MaybeR PrevCommitteeR) No

prevConstitution :: Era era => Term era (Maybe (GovPurposeId 'ConstitutionPurpose era))
prevConstitution = Var $ V "prevConstitution" (MaybeR PrevConstitutionR) No

-}

ppUpdateChildren :: Era era => Term era (Set (GovActionId (EraCrypto era)))
ppUpdateChildren :: forall era. Era era => Term era (Set (GovActionId (EraCrypto era)))
ppUpdateChildren = 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
"ppUpdateChildren" (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

hardForkChildren :: Era era => Term era (Set (GovActionId (EraCrypto era)))
hardForkChildren :: forall era. Era era => Term era (Set (GovActionId (EraCrypto era)))
hardForkChildren = 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
"hardForkChildren" (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

committeeChildren :: Era era => Term era (Set (GovActionId (EraCrypto era)))
committeeChildren :: forall era. Era era => Term era (Set (GovActionId (EraCrypto era)))
committeeChildren = 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
"committeeChildren" (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

constitutionChildren :: Era era => Term era (Set (GovActionId (EraCrypto era)))
constitutionChildren :: forall era. Era era => Term era (Set (GovActionId (EraCrypto era)))
constitutionChildren = 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
"constitutionChildren" (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

-- ================
-- Lenses

pparamsFL :: Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL :: forall era. Proof era -> Lens' (PParams era) (PParamsF era)
pparamsFL Proof era
p = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p) (\PParams era
_ (PParamsF Proof era
_ PParams era
x) -> PParams era
x)

pparamsMaybeFL :: Proof era -> Lens' (Maybe (PParams era)) (Maybe (PParamsF era))
pparamsMaybeFL :: forall era.
Proof era -> Lens' (Maybe (PParams era)) (Maybe (PParamsF era))
pparamsMaybeFL Proof era
p =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall era. Proof era -> PParams era -> PParamsF era
PParamsF Proof era
p))
    (\Maybe (PParams era)
_ -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\(PParamsF Proof era
_ PParams era
x) -> PParams era
x))

smCommL :: Lens' (StrictMaybe (Committee era)) (Committee era)
smCommL :: forall era. Lens' (StrictMaybe (Committee era)) (Committee era)
smCommL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens forall {era}. StrictMaybe (Committee era) -> Committee era
getter (\StrictMaybe (Committee era)
_ Committee era
t -> forall a. a -> StrictMaybe a
SJust Committee era
t)
  where
    getter :: StrictMaybe (Committee era) -> Committee era
getter StrictMaybe (Committee era)
SNothing = forall era.
Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval -> Committee era
Committee forall k a. Map k a
Map.empty forall a. Bounded a => a
maxBound
    getter (SJust Committee era
x) = Committee era
x

proposedMapL ::
  Proof era ->
  Lens' (ProposedPPUpdates era) (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
proposedMapL :: forall era.
Proof era
-> Lens'
     (ProposedPPUpdates era)
     (Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era))
proposedMapL Proof era
p =
  forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens
    (\(ProposedPPUpdates Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
x) -> forall a b k. (a -> b) -> Map k a -> Map k b
Map.map (forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF Proof era
p) Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
x)
    (\(ProposedPPUpdates Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdate era)
_) Map (KeyHash 'Genesis (EraCrypto era)) (PParamsUpdateF era)
y -> 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))

pair1 :: Era era => Rep era a -> Term era a
pair1 :: forall era a. Era era => Rep era a -> Term era a
pair1 Rep era a
rep = 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
"pair1" Rep era a
rep forall era s t. Access era s t
No)

pair2 :: Era era => Rep era b -> Term era b
pair2 :: forall era a. Era era => Rep era a -> Term era a
pair2 Rep era b
rep = 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
"pair2" Rep era b
rep forall era s t. Access era s t
No)

pairT ::
  forall era a b.
  (Typeable a, Typeable b, Era era) =>
  Rep era a ->
  Rep era b ->
  RootTarget era (a, b) (a, b)
pairT :: forall era a b.
(Typeable a, Typeable b, Era era) =>
Rep era a -> Rep era b -> RootTarget era (a, b) (a, b)
pairT Rep era a
repa Rep era b
repb =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"(,)" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(a, b)) (,)
    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 a. Era era => Rep era a -> Term era a
pair1 Rep era a
repa) forall a b. Lens' (a, b) a
fstL
    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 a. Era era => Rep era a -> Term era a
pair2 Rep era b
repb) forall a b. Lens' (a, b) b
sndL

-- ==========================================
-- Targets for GovActionState
-- The variables xxV align with the field selectors gasXx

idV :: Era era => Term era (GovActionId (EraCrypto era))
idV :: forall era. Era era => Term era (GovActionId (EraCrypto era))
idV = 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
"idV" forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR forall era s t. Access era s t
No)

committeeVotesV :: Era era => Term era (Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote)
committeeVotesV :: forall era.
Era era =>
Term era (Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote)
committeeVotesV = 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
"committeeVotesV" (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 'HotCommitteeRole (EraCrypto era))
CommHotCredR forall era. Rep era Vote
VoteR) forall era s t. Access era s t
No)

drepVotesV :: Era era => Term era (Map (Credential 'DRepRole (EraCrypto era)) Vote)
drepVotesV :: forall era.
Era era =>
Term era (Map (Credential 'DRepRole (EraCrypto era)) Vote)
drepVotesV = 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
"drepVotesV" (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. Rep era Vote
VoteR) forall era s t. Access era s t
No)

stakePoolVotesV :: Era era => Term era (Map (KeyHash 'StakePool (EraCrypto era)) Vote)
stakePoolVotesV :: forall era.
Era era =>
Term era (Map (KeyHash 'StakePool (EraCrypto era)) Vote)
stakePoolVotesV = 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
"stakePoolVotesV" (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 Vote
VoteR) forall era s t. Access era s t
No)

depositV :: Era era => Term era Coin
depositV :: forall era. Era era => Term era Coin
depositV = 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
"depositV" forall era. Rep era Coin
CoinR forall era s t. Access era s t
No)

returnAddrV :: Era era => Term era (RewardAccount (EraCrypto era))
returnAddrV :: forall era. Era era => Term era (RewardAccount (EraCrypto era))
returnAddrV = 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
"returnAddrV" forall era. Era era => Rep era (RewardAccount (EraCrypto era))
RewardAccountR forall era s t. Access era s t
No)

actionV :: Era era => Term era (GovAction era)
actionV :: forall era. Era era => Term era (GovAction era)
actionV = 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
"actionV" forall era. Era era => Rep era (GovAction era)
GovActionR forall era s t. Access era s t
No)

proposedInV :: Era era => Term era EpochNo
proposedInV :: forall era. Era era => Term era EpochNo
proposedInV = 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
"proposedInV" forall era. Rep era EpochNo
EpochR forall era s t. Access era s t
No)

expiresAfterV :: Era era => Term era EpochNo
expiresAfterV :: forall era. Era era => Term era EpochNo
expiresAfterV = 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
"expiresAfterV" forall era. Rep era EpochNo
EpochR forall era s t. Access era s t
No)

childrenV :: Era era => Term era (Set (GovActionId (EraCrypto era)))
childrenV :: forall era. Era era => Term era (Set (GovActionId (EraCrypto era)))
childrenV = 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
"childrenV" (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)

anchorV :: Era era => Term era (Anchor (EraCrypto era))
anchorV :: forall era. Era era => Term era (Anchor (EraCrypto era))
anchorV = 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
"anchorV" forall era. Era era => Rep era (Anchor (EraCrypto era))
AnchorR forall era s t. Access era s t
No)

govActionStateTarget ::
  forall era. Era era => RootTarget era (GovActionState era) (GovActionState era)
govActionStateTarget :: forall era.
Era era =>
RootTarget era (GovActionState era) (GovActionState era)
govActionStateTarget =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"GovActionState" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovActionState era)) forall era.
GovActionId (EraCrypto era)
-> Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote
-> Map (Credential 'DRepRole (EraCrypto era)) Vote
-> Map (KeyHash 'StakePool (EraCrypto era)) Vote
-> ProposalProcedure era
-> EpochNo
-> EpochNo
-> GovActionState era
GovActionState
    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 (GovActionId (EraCrypto era))
idV forall era.
Lens' (GovActionState era) (GovActionId (EraCrypto era))
gasIdL
    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 'HotCommitteeRole (EraCrypto era)) Vote)
committeeVotesV forall era.
Lens'
  (GovActionState era)
  (Map (Credential 'HotCommitteeRole (EraCrypto era)) Vote)
gasCommitteeVotesL
    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 'DRepRole (EraCrypto era)) Vote)
drepVotesV forall era.
Lens'
  (GovActionState era)
  (Map (Credential 'DRepRole (EraCrypto era)) Vote)
gasDRepVotesL
    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)) Vote)
stakePoolVotesV forall era.
Lens'
  (GovActionState era)
  (Map (KeyHash 'StakePool (EraCrypto era)) Vote)
gasStakePoolVotesL
    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 root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"ProposalProcedure" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(ProposalProcedure era)) forall era.
Coin
-> RewardAccount (EraCrypto era)
-> GovAction era
-> Anchor (EraCrypto era)
-> ProposalProcedure era
ProposalProcedure
          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
depositV forall era. Lens' (ProposalProcedure era) Coin
pProcDepositL
          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 (RewardAccount (EraCrypto era))
returnAddrV forall era.
Lens' (ProposalProcedure era) (RewardAccount (EraCrypto era))
pProcReturnAddrL
          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 (GovAction era)
actionV forall era. Lens' (ProposalProcedure era) (GovAction era)
pProcGovActionL
          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 (Anchor (EraCrypto era))
anchorV forall era. Lens' (ProposalProcedure era) (Anchor (EraCrypto era))
pProcAnchorL
      )
      forall era. Lens' (GovActionState era) (ProposalProcedure era)
gasProposalProcedureL
    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 EpochNo
proposedInV forall era. Lens' (GovActionState era) EpochNo
gasProposedInL
    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 EpochNo
expiresAfterV forall era. Lens' (GovActionState era) EpochNo
gasExpiresAfterL

-- ==============================================================
-- Targets for GovAction, The model does not make the distinction
-- the newtype (PrevGovActionId era) and (GovActionId era), The
-- targets provide the coercions to produce the real data from the Model

-- | Lift the Model to the real type
liftId :: Maybe (GovActionId (EraCrypto era)) -> StrictMaybe (GovPurposeId p era)
liftId :: forall era (p :: GovActionPurpose).
Maybe (GovActionId (EraCrypto era))
-> StrictMaybe (GovPurposeId p era)
liftId Maybe (GovActionId (EraCrypto era))
x = forall (p :: GovActionPurpose) era.
GovActionId (EraCrypto era) -> GovPurposeId p era
GovPurposeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (GovActionId (EraCrypto era))
x)

-- | Drop the real type back to the Model
dropId :: StrictMaybe (GovPurposeId p era) -> Maybe (GovActionId (EraCrypto era))
dropId :: forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era)
-> Maybe (GovActionId (EraCrypto era))
dropId StrictMaybe (GovPurposeId p era)
x = forall (p :: GovActionPurpose) era.
GovPurposeId p era -> GovActionId (EraCrypto era)
unGovPurposeId forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (GovPurposeId p era)
x)

-- =====================
-- Variables for the fields of GovAction

gaPrevId :: Era era => Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId :: forall era.
Era era =>
Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId = 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
"gaPrevId" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Era era => Rep era (GovActionId (EraCrypto era))
GovActionIdR) forall era s t. Access era s t
No)

gaPParamsUpdate :: Reflect era => Term era (PParamsUpdateF era)
gaPParamsUpdate :: forall era. Reflect era => Term era (PParamsUpdateF era)
gaPParamsUpdate = 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
"gsPParamsUpdate" (forall era. Era era => Proof era -> Rep era (PParamsUpdateF era)
PParamsUpdateR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No)

gaProtVer :: Reflect era => Term era ProtVer
gaProtVer :: forall era. Reflect era => Term era ProtVer
gaProtVer = 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
"gaProtVer" (forall era. Era era => Proof era -> Rep era ProtVer
ProtVerR forall era. Reflect era => Proof era
reify) forall era s t. Access era s t
No)

gaRewardAccount :: Era era => Term era (Map (RewardAccount (EraCrypto era)) Coin)
gaRewardAccount :: forall era.
Era era =>
Term era (Map (RewardAccount (EraCrypto era)) Coin)
gaRewardAccount = 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
"gaRewardAccount" (forall t era r.
Ord t =>
Rep era t -> Rep era r -> Rep era (Map t r)
MapR forall era. Era era => Rep era (RewardAccount (EraCrypto era))
RewardAccountR forall era. Rep era Coin
CoinR) forall era s t. Access era s t
No)

gaRemMember :: Era era => Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
gaRemMember :: forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
gaRemMember = 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
"gaRemMember" (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)

gaAddMember :: Era era => Term era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
gaAddMember :: forall era.
Era era =>
Term
  era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
gaAddMember = 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
"gaAddMember" (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. Rep era EpochNo
EpochR) forall era s t. Access era s t
No)

gaThreshold :: Era era => Term era UnitInterval
gaThreshold :: forall era. Era era => Term era UnitInterval
gaThreshold = 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
"gaThreshold" forall era. Rep era UnitInterval
UnitIntervalR forall era s t. Access era s t
No)

gaPolicy :: Era era => Term era (Maybe (ScriptHash (EraCrypto era)))
gaPolicy :: forall era.
Era era =>
Term era (Maybe (ScriptHash (EraCrypto era)))
gaPolicy = 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
"gaPolicy" (forall era t. Rep era t -> Rep era (Maybe t)
MaybeR forall era. Era era => Rep era (ScriptHash (EraCrypto era))
ScriptHashR) forall era s t. Access era s t
No)

gaConstitutionAnchor :: Era era => Term era (Anchor (EraCrypto era))
gaConstitutionAnchor :: forall era. Era era => Term era (Anchor (EraCrypto era))
gaConstitutionAnchor = 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
"gaConstitutionAnchor" forall era. Era era => Rep era (Anchor (EraCrypto era))
AnchorR forall era s t. Access era s t
No)

gaNewConstitution :: Era era => Term era (Constitution era)
gaNewConstitution :: forall era. Era era => Term era (Constitution era)
gaNewConstitution = 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
"gaNewConstitution" forall era. Era era => Rep era (Constitution era)
ConstitutionR forall era s t. Access era s t
No)

-- ===================================
-- The partial Targets, one for each constructor of GovAction

constitutionT :: forall era. Reflect era => RootTarget era (Constitution era) (Constitution era)
constitutionT :: forall era.
Reflect era =>
RootTarget era (Constitution era) (Constitution era)
constitutionT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"Constitution" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(Constitution era)) (\Anchor StandardCrypto
x Maybe (ScriptHash StandardCrypto)
y -> forall era.
Anchor (EraCrypto era)
-> StrictMaybe (ScriptHash (EraCrypto era)) -> Constitution era
Constitution Anchor StandardCrypto
x forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (ScriptHash StandardCrypto)
y)
    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 (Anchor (EraCrypto era))
gaConstitutionAnchor forall era. Lens' (Constitution era) (Anchor (EraCrypto era))
constitutionAnchorL
    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 (Maybe (ScriptHash (EraCrypto era)))
gaPolicy (forall era.
Lens' (Constitution era) (StrictMaybe (ScriptHash (EraCrypto era)))
constitutionScriptL forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. Lens' (StrictMaybe x) (Maybe x)
strictMaybeToMaybeL)

parameterChangeT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
parameterChangeT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
parameterChangeT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert
    String
"ParameterChange"
    (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era))
    (\Maybe (GovActionId StandardCrypto)
x PParamsUpdateF era
y Maybe (ScriptHash StandardCrypto)
c -> forall era.
StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
-> PParamsUpdate era
-> StrictMaybe (ScriptHash (EraCrypto era))
-> GovAction era
ParameterChange (forall era (p :: GovActionPurpose).
Maybe (GovActionId (EraCrypto era))
-> StrictMaybe (GovPurposeId p era)
liftId Maybe (GovActionId StandardCrypto)
x) (forall era. PParamsUpdateF era -> PParamsUpdate era
unPParamsUpdate PParamsUpdateF era
y) (forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (ScriptHash StandardCrypto)
c))
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId (\case (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
x PParamsUpdate era
_ StrictMaybe (ScriptHash (EraCrypto era))
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era)
-> Maybe (GovActionId (EraCrypto era))
dropId StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial
      forall era. Reflect era => Term era (PParamsUpdateF era)
gaPParamsUpdate
      (\case (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
y StrictMaybe (ScriptHash (EraCrypto era))
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall era. Proof era -> PParamsUpdate era -> PParamsUpdateF era
PParamsUpdateF forall era. Reflect era => Proof era
reify PParamsUpdate era
y; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (ScriptHash (EraCrypto era)))
gaPolicy (\case (ParameterChange StrictMaybe (GovPurposeId 'PParamUpdatePurpose era)
_ PParamsUpdate era
_ StrictMaybe (ScriptHash (EraCrypto era))
x) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (ScriptHash (EraCrypto era))
x; GovAction era
_ -> forall a. Maybe a
Nothing)

hardForkInitiationT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
hardForkInitiationT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
hardForkInitiationT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"HardForkInitiation" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era)) (\Maybe (GovActionId StandardCrypto)
x ProtVer
y -> forall era.
StrictMaybe (GovPurposeId 'HardForkPurpose era)
-> ProtVer -> GovAction era
HardForkInitiation (forall era (p :: GovActionPurpose).
Maybe (GovActionId (EraCrypto era))
-> StrictMaybe (GovPurposeId p era)
liftId Maybe (GovActionId StandardCrypto)
x) ProtVer
y)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId (\case (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
x ProtVer
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era)
-> Maybe (GovActionId (EraCrypto era))
dropId StrictMaybe (GovPurposeId 'HardForkPurpose era)
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era. Reflect era => Term era ProtVer
gaProtVer (\case (HardForkInitiation StrictMaybe (GovPurposeId 'HardForkPurpose era)
_ ProtVer
y) -> forall a. a -> Maybe a
Just ProtVer
y; GovAction era
_ -> forall a. Maybe a
Nothing)

treasuryWithdrawalsT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
treasuryWithdrawalsT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
treasuryWithdrawalsT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert
    String
"TreasuryWithdrawals"
    (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era))
    (\Map (RewardAcnt StandardCrypto) Coin
x Maybe (ScriptHash StandardCrypto)
y -> forall era.
Map (RewardAccount (EraCrypto era)) Coin
-> StrictMaybe (ScriptHash (EraCrypto era)) -> GovAction era
TreasuryWithdrawals Map (RewardAcnt StandardCrypto) Coin
x forall a b. (a -> b) -> a -> b
$ forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe Maybe (ScriptHash StandardCrypto)
y)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Map (RewardAccount (EraCrypto era)) Coin)
gaRewardAccount (\case (TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
x StrictMaybe (ScriptHash (EraCrypto era))
_) -> forall a. a -> Maybe a
Just Map (RewardAccount (EraCrypto era)) Coin
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (ScriptHash (EraCrypto era)))
gaPolicy (\case (TreasuryWithdrawals Map (RewardAccount (EraCrypto era)) Coin
_ StrictMaybe (ScriptHash (EraCrypto era))
y) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe StrictMaybe (ScriptHash (EraCrypto era))
y; GovAction era
_ -> forall a. Maybe a
Nothing)

noConfidenceT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
noConfidenceT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
noConfidenceT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"NoConfidence" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era)) (\Maybe (GovActionId StandardCrypto)
x -> forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era) -> GovAction era
NoConfidence (forall era (p :: GovActionPurpose).
Maybe (GovActionId (EraCrypto era))
-> StrictMaybe (GovPurposeId p era)
liftId Maybe (GovActionId StandardCrypto)
x))
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId (\case (NoConfidence StrictMaybe (GovPurposeId 'CommitteePurpose era)
x) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era)
-> Maybe (GovActionId (EraCrypto era))
dropId StrictMaybe (GovPurposeId 'CommitteePurpose era)
x; GovAction era
_ -> forall a. Maybe a
Nothing)

updateCommitteeT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
updateCommitteeT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
updateCommitteeT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"UpdateCommittee" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era)) (\Maybe (GovActionId StandardCrypto)
w Set (Credential 'ColdCommitteeRole StandardCrypto)
x Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo
y UnitInterval
z -> forall era.
StrictMaybe (GovPurposeId 'CommitteePurpose era)
-> Set (Credential 'ColdCommitteeRole (EraCrypto era))
-> Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
-> UnitInterval
-> GovAction era
UpdateCommittee (forall era (p :: GovActionPurpose).
Maybe (GovActionId (EraCrypto era))
-> StrictMaybe (GovPurposeId p era)
liftId Maybe (GovActionId StandardCrypto)
w) Set (Credential 'ColdCommitteeRole StandardCrypto)
x Map (Credential 'ColdCommitteeRole StandardCrypto) EpochNo
y UnitInterval
z)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId (\case (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
x Set (Credential 'ColdCommitteeRole (EraCrypto era))
_ Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
_ UnitInterval
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era)
-> Maybe (GovActionId (EraCrypto era))
dropId StrictMaybe (GovPurposeId 'CommitteePurpose era)
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Set (Credential 'ColdCommitteeRole (EraCrypto era)))
gaRemMember (\case (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole (EraCrypto era))
x Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
_ UnitInterval
_) -> forall a. a -> Maybe a
Just Set (Credential 'ColdCommitteeRole (EraCrypto era))
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term
  era (Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo)
gaAddMember (\case (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole (EraCrypto era))
_ Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
x UnitInterval
_) -> forall a. a -> Maybe a
Just Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era. Era era => Term era UnitInterval
gaThreshold (\case (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
_ Set (Credential 'ColdCommitteeRole (EraCrypto era))
_ Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
_ UnitInterval
x) -> forall a. a -> Maybe a
Just UnitInterval
x; GovAction era
_ -> forall a. Maybe a
Nothing)

newConstitutionT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
newConstitutionT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
newConstitutionT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"NewConstitution" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era)) (\Maybe (GovActionId StandardCrypto)
x Constitution era
y -> forall era.
StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
-> Constitution era -> GovAction era
NewConstitution (forall era (p :: GovActionPurpose).
Maybe (GovActionId (EraCrypto era))
-> StrictMaybe (GovPurposeId p era)
liftId Maybe (GovActionId StandardCrypto)
x) Constitution era
y)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era.
Era era =>
Term era (Maybe (GovActionId (EraCrypto era)))
gaPrevId (\case (UpdateCommittee StrictMaybe (GovPurposeId 'CommitteePurpose era)
x Set (Credential 'ColdCommitteeRole (EraCrypto era))
_ Map (Credential 'ColdCommitteeRole (EraCrypto era)) EpochNo
_ UnitInterval
_) -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (p :: GovActionPurpose) era.
StrictMaybe (GovPurposeId p era)
-> Maybe (GovActionId (EraCrypto era))
dropId StrictMaybe (GovPurposeId 'CommitteePurpose era)
x; GovAction era
_ -> forall a. Maybe a
Nothing)
    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 -> (root -> Maybe t) -> RootTarget era root t
Partial forall era. Era era => Term era (Constitution era)
gaNewConstitution (\case (NewConstitution StrictMaybe (GovPurposeId 'ConstitutionPurpose era)
_ Constitution era
y) -> forall a. a -> Maybe a
Just Constitution era
y; GovAction era
_ -> forall a. Maybe a
Nothing)

infoActionT :: forall era. Reflect era => RootTarget era (GovAction era) (GovAction era)
infoActionT :: forall era.
Reflect era =>
RootTarget era (GovAction era) (GovAction era)
infoActionT =
  forall root t r era.
String -> TypeRep root -> (t -> r) -> RootTarget era root (t -> r)
Invert String
"InfoAction" (forall {k} (a :: k). Typeable a => TypeRep a
typeRep @(GovAction era)) (\() -> forall era. GovAction era
InfoAction)
    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 t. Rep era t -> t -> Term era t
Lit forall era. Rep era ()
UnitR ()) (forall s a. (s -> a) -> SimpleGetter s a
to (forall a b. a -> b -> a
const ()))