{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Dijkstra.Imp.PoolSpec (spec) where

import Cardano.Ledger.BaseTypes
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra.Core
import Cardano.Ledger.Dijkstra.PParams (ppMaxPledgeLeverageL)
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.Rules (ShelleyPoolPredFailure (..))
import Cardano.Ledger.State
import Data.Coerce (coerce)
import Data.Foldable (fold)
import qualified Data.Map.Strict as Map
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Set as Set
import Lens.Micro ((%~), (&), (.~))
import Test.Cardano.Ledger.Core.Rational ((%!))
import Test.Cardano.Ledger.Dijkstra.ImpTest
import Test.Cardano.Ledger.Imp.Common

-- | Slightly less than half of the total supply, leaving the rest in circulation.
reserves :: Coin
reserves :: Coin
reserves = Integer -> Coin
Coin Integer
20_000_000_000_000_000

ownerStake :: Coin
ownerStake :: Coin
ownerStake = Integer -> Coin
Coin Integer
10_000_000_000_000

delegatorStake :: Coin
delegatorStake :: Coin
delegatorStake = Integer -> Coin
Coin Integer
90_000_000_000_000

registerPoolWithPledge ::
  DijkstraEraImp era =>
  Coin ->
  ImpTestM era (KeyHash StakePool, [Credential Staking])
registerPoolWithPledge :: forall era.
DijkstraEraImp era =>
Coin -> ImpTestM era (KeyHash StakePool, [Credential Staking])
registerPoolWithPledge Coin
pledge = do
  poolId <- ImpM (LedgerSpec era) (KeyHash StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash
  ownerKeyHash <- freshKeyHash
  delegatorKeyHash <- freshKeyHash
  let owner = KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
ownerKeyHash
      delegator = KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj KeyHash Staking
delegatorKeyHash
  -- Give the stake credentials some stake to delegate.
  ownerPayment <- freshKeyHash @Payment
  delegatorPayment <- freshKeyHash @Payment
  sendCoinTo_ (mkAddr ownerPayment owner) ownerStake
  sendCoinTo_ (mkAddr delegatorPayment delegator) delegatorStake
  -- The pool pays its rewards into the account of its owner.
  ownerAccountAddress <- registerStakeCredential owner
  _ <- registerStakeCredential delegator
  minPoolCost <- getsPParams ppMinPoolCostL
  registerPoolWithParams
    ( \StakePoolParams era
poolParams ->
        StakePoolParams era
poolParams
          { sppPledge = pledge
          , sppOwners = Set.singleton ownerKeyHash
          , sppCost = minPoolCost
          , sppMargin = 0 %! 1
          }
    )
    poolId
    ownerAccountAddress
  delegateStake owner poolId
  delegateStake delegator poolId
  pure (poolId, [owner, delegator])

-- | The total rewards that have been paid out to a stake pool and its delegators.
poolRewards :: (HasCallStack, EraCertState era) => [Credential Staking] -> ImpTestM era Coin
poolRewards :: forall era.
(HasCallStack, EraCertState era) =>
[Credential Staking] -> ImpTestM era Coin
poolRewards = ([Coin] -> Coin)
-> ImpM (LedgerSpec era) [Coin] -> ImpM (LedgerSpec era) Coin
forall a b.
(a -> b) -> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Coin] -> Coin
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (ImpM (LedgerSpec era) [Coin] -> ImpM (LedgerSpec era) Coin)
-> ([Credential Staking] -> ImpM (LedgerSpec era) [Coin])
-> [Credential Staking]
-> ImpM (LedgerSpec era) Coin
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Credential Staking -> ImpM (LedgerSpec era) Coin)
-> [Credential Staking] -> ImpM (LedgerSpec era) [Coin]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> [a] -> f [b]
traverse Credential Staking -> ImpM (LedgerSpec era) Coin
forall era.
(HasCallStack, EraCertState era) =>
Credential Staking -> ImpTestM era Coin
getBalance

-- | Register two pools that are identical, except that the second one declares a pledge
-- that is a thousandth of the pledge of the first one, then have both of them mint the
-- same number of blocks, and report the rewards that each of them earned.
--
-- The first pool is well pledged: its pledge is a tenth of its stake, which is exactly
-- the leverage that `maxPledgeLeverage` is set to whenever it is set in this spec.
rewardsOfWellAndOverPledgedPools ::
  DijkstraEraImp era =>
  ImpTestM era (Coin, Coin)
rewardsOfWellAndOverPledgedPools :: forall era. DijkstraEraImp era => ImpTestM era (Coin, Coin)
rewardsOfWellAndOverPledgedPools = do
  -- ImpSpec starts out with the whole supply accounted for in the reserves, while at the
  -- same time holding all of it in the initial UTxO, which leaves nothing in circulation.
  -- Rewards are handed out of the reserves and are proportional to the stake of a pool
  -- relative to the ADA in circulation, so both need to be realistic for a pool to earn a
  -- sensible amount of rewards.
  (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall era.
(NewEpochState era -> NewEpochState era) -> ImpTestM era ()
modifyNES ((NewEpochState era -> NewEpochState era) -> ImpTestM era ())
-> (NewEpochState era -> NewEpochState era) -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Identity (EpochState era))
-> NewEpochState era -> Identity (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Identity (EpochState era))
 -> NewEpochState era -> Identity (NewEpochState era))
-> ((Coin -> Identity Coin)
    -> EpochState era -> Identity (EpochState era))
-> (Coin -> Identity Coin)
-> NewEpochState era
-> Identity (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ChainAccountState -> Identity ChainAccountState)
-> EpochState era -> Identity (EpochState era)
forall era. Lens' (EpochState era) ChainAccountState
forall (t :: * -> *) era.
CanSetChainAccountState t =>
Lens' (t era) ChainAccountState
chainAccountStateL ((ChainAccountState -> Identity ChainAccountState)
 -> EpochState era -> Identity (EpochState era))
-> ((Coin -> Identity Coin)
    -> ChainAccountState -> Identity ChainAccountState)
-> (Coin -> Identity Coin)
-> EpochState era
-> Identity (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Coin -> Identity Coin)
-> ChainAccountState -> Identity ChainAccountState
Lens' ChainAccountState Coin
casReservesL ((Coin -> Identity Coin)
 -> NewEpochState era -> Identity (NewEpochState era))
-> Coin -> NewEpochState era -> NewEpochState era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Coin
reserves
  wellPledged <- Coin -> ImpTestM era (KeyHash StakePool, [Credential Staking])
forall era.
DijkstraEraImp era =>
Coin -> ImpTestM era (KeyHash StakePool, [Credential Staking])
registerPoolWithPledge Coin
ownerStake
  overLeveraged <- registerPoolWithPledge $ Coin (unCoin ownerStake `div` 1_000)
  -- Pay out the pledges and delegations, then let the stake distribution settle into the
  -- snapshot that the rewards for the epoch after the next one are computed from.
  passNEpochs 2
  -- Both pools mint the same number of blocks, so that they have the same apparent
  -- performance. The transactions also fill up the fee pot that is handed out as rewards.
  replicateM_ 3 $
    forM_ [fst wellPledged, fst overLeveraged] $ \KeyHash StakePool
poolId ->
      KeyHash BlockIssuer -> ImpTestM era () -> ImpTestM era ()
forall era a.
(HasCallStack, ShelleyEraImp era) =>
KeyHash BlockIssuer -> ImpTestM era a -> ImpTestM era ()
withIssuerAndTxsInBlock_ (KeyHash StakePool -> KeyHash BlockIssuer
forall a b. Coercible a b => a -> b
coerce KeyHash StakePool
poolId) (ImpTestM era () -> ImpTestM era ())
-> ImpTestM era () -> ImpTestM era ()
forall a b. (a -> b) -> a -> b
$ do
        addr <- ImpM (LedgerSpec era) Addr
forall s (m :: * -> *) g.
(HasKeyPairs s, MonadState s m, HasStatefulGen g m, MonadGen m) =>
m Addr
freshKeyAddr_
        sendCoinTo_ addr $ Coin 1_000_000_000
  -- Rewards for an epoch are only handed out two epoch boundaries later.
  passNEpochs 3
  (,) <$> poolRewards (snd wellPledged) <*> poolRewards (snd overLeveraged)

spec :: forall era. DijkstraEraImp era => SpecWith (ImpInit (LedgerSpec era))
spec :: forall era.
DijkstraEraImp era =>
SpecWith (ImpInit (LedgerSpec era))
spec = String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"POOL" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"Register and re-register pools" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"re-register a pool with its own future VRF" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (kh, vrf) <- ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool
      vrfNew <- freshKeyHashVRF
      tx <- registerPoolTx <$> poolParams kh vrfNew
      submitTx_ tx
      expectPool kh (Just vrf)
      expectFuturePool kh (Just vrfNew)
      -- re-registering with the VRF already recorded in the pool's own
      -- future params should succeed
      submitTx_ tx
      expectPool kh (Just vrf)
      expectFuturePool kh (Just vrfNew)
      expectVRFs [(vrf, 1), (vrfNew, 1)]
      passEpoch
      expectPool kh (Just vrfNew)
      expectFuturePool kh Nothing
      expectVRFs [(vrfNew, 1)]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"keep tracking the active VRF after re-registering with it and then with a fresh one" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (kh, vrf) <- ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool
      -- re-register with the pool's own active VRF ...
      registerPoolTx <$> poolParams kh vrf >>= submitTx_
      expectFuturePool kh (Just vrf)
      expectVRFs [(vrf, 1)]
      -- ... and then with a fresh one
      vrfNew <- freshKeyHashVRF
      registerPoolTx <$> poolParams kh vrfNew >>= submitTx_
      -- the pool keeps producing blocks with the original VRF until the
      -- epoch boundary, so it must still be tracked
      expectPool kh (Just vrf)
      expectVRFs [(vrf, 1), (vrfNew, 1)]
      khNew <- freshKeyHash
      registerPoolTx <$> poolParams khNew vrf >>= \Tx TopTx era
tx ->
        Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx TopTx era
tx (EraRuleFailure "LEDGER" era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
EraRuleFailure "LEDGER" era
-> NonEmpty (EraRuleFailure "LEDGER" era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraRuleFailure "LEDGER" era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> (ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era)
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ShelleyPoolPredFailure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
forall era.
KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
VRFKeyHashAlreadyRegistered KeyHash StakePool
khNew VRFVerKeyHash StakePoolVRF
vrf)
      passEpoch
      expectPool kh (Just vrfNew)
      expectVRFs [(vrfNew, 1)]
      -- after the epoch boundary the original VRF can be taken over
      registerPoolTx <$> poolParams khNew vrf >>= submitTx_
      expectVRFs [(vrf, 1), (vrfNew, 1)]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"re-registering with the active VRF releases the pending future VRF" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (kh, vrf) <- ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool
      vrfNew <- freshKeyHashVRF
      registerPoolTx <$> poolParams kh vrfNew >>= submitTx_
      expectVRFs [(vrf, 1), (vrfNew, 1)]
      -- going back to the active VRF frees the previously requested one
      registerPoolTx <$> poolParams kh vrf >>= submitTx_
      expectFuturePool kh (Just vrf)
      expectVRFs [(vrf, 1)]
      khNew <- freshKeyHash
      registerPoolTx <$> poolParams khNew vrfNew >>= submitTx_
      expectPool khNew (Just vrfNew)
      expectVRFs [(vrf, 1), (vrfNew, 1)]

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"re-register a pool whose VRF is shared with another pool" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (kh1, vrf) <- ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool
      _ <- registerPoolSharingVRF vrf
      expectVRFs [(vrf, 2)]
      -- neither pool may keep the shared VRF when re-registering ...
      registerPoolTx <$> poolParams kh1 vrf >>= \Tx TopTx era
tx ->
        Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx TopTx era
tx (EraRuleFailure "LEDGER" era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
EraRuleFailure "LEDGER" era
-> NonEmpty (EraRuleFailure "LEDGER" era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraRuleFailure "LEDGER" era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> (ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era)
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ShelleyPoolPredFailure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
forall era.
KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
VRFKeyHashAlreadyRegistered KeyHash StakePool
kh1 VRFVerKeyHash StakePoolVRF
vrf)
      -- ... but either may switch to a fresh one
      vrfNew <- freshKeyHashVRF
      registerPoolTx <$> poolParams kh1 vrfNew >>= submitTx_
      expectFuturePool kh1 (Just vrfNew)
      expectVRFs [(vrf, 2), (vrfNew, 1)]
      -- and the shared VRF stays taken while any pool still uses it
      kh3 <- freshKeyHash
      registerPoolTx <$> poolParams kh3 vrf >>= \Tx TopTx era
tx ->
        Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx TopTx era
tx (EraRuleFailure "LEDGER" era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
EraRuleFailure "LEDGER" era
-> NonEmpty (EraRuleFailure "LEDGER" era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraRuleFailure "LEDGER" era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> (ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era)
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ShelleyPoolPredFailure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
forall era.
KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
VRFKeyHashAlreadyRegistered KeyHash StakePool
kh3 VRFVerKeyHash StakePoolVRF
vrf)

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"register a pool with a VRF shared by two pools once both have retired" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      (kh1, vrf) <- ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool
      kh2 <- registerPoolSharingVRF vrf
      expectVRFs [(vrf, 2)]
      -- retiring one of the two pools leaves the VRF in use by the other one ...
      retirePoolTx kh1 (EpochInterval 1) >>= submitTx_
      passEpoch
      expectPool kh1 Nothing
      expectPool kh2 (Just vrf)
      expectVRFs [(vrf, 1)]
      kh3 <- freshKeyHash
      registerPoolTx <$> poolParams kh3 vrf >>= \Tx TopTx era
tx ->
        Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpM (LedgerSpec era) ()
forall era.
(HasCallStack, ShelleyEraImp era) =>
Tx TopTx era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
-> ImpTestM era ()
submitFailingTx Tx TopTx era
tx (EraRuleFailure "LEDGER" era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
EraRuleFailure "LEDGER" era
-> NonEmpty (EraRuleFailure "LEDGER" era)
forall a. a -> NonEmpty a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EraRuleFailure "LEDGER" era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> (ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era)
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyPoolPredFailure era -> EraRuleFailure "LEDGER" era
forall (rule :: Symbol) (t :: * -> *) era.
InjectRuleFailure rule t era =>
t era -> EraRuleFailure rule era
injectFailure (ShelleyPoolPredFailure era
 -> NonEmpty (PredicateFailure (EraRule "LEDGER" era)))
-> ShelleyPoolPredFailure era
-> NonEmpty (PredicateFailure (EraRule "LEDGER" era))
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
forall era.
KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
VRFKeyHashAlreadyRegistered KeyHash StakePool
kh3 VRFVerKeyHash StakePoolVRF
vrf)
      -- ... and only once that one has retired as well does the VRF become available
      retirePoolTx kh2 (EpochInterval 1) >>= submitTx_
      passEpoch
      expectPool kh2 Nothing
      expectVRFs []
      registerPoolTx <$> poolParams kh3 vrf >>= submitTx_
      expectPool kh3 (Just vrf)
      expectVRFs [(vrf, 1)]

  String
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"maxPledgeLeverage" (SpecWith (ImpInit (LedgerSpec era))
 -> SpecWith (ImpInit (LedgerSpec era)))
-> SpecWith (ImpInit (LedgerSpec era))
-> SpecWith (ImpInit (LedgerSpec era))
forall a b. (a -> b) -> a -> b
$ do
    -- The pledge influence factor also rewards a pool for pledging more, which would
    -- make the two pools below earn different rewards for a reason that has nothing to
    -- do with the pledge leverage. Setting it to zero isolates the leverage cap.
    let withoutPledgeInfluence :: ImpM (LedgerSpec era) ()
withoutPledgeInfluence = (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp -> PParams era
pp PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (NonNegativeInterval -> Identity NonNegativeInterval)
-> PParams era -> Identity (PParams era)
forall era.
EraPParams era =>
Lens' (PParams era) NonNegativeInterval
Lens' (PParams era) NonNegativeInterval
ppA0L ((NonNegativeInterval -> Identity NonNegativeInterval)
 -> PParams era -> Identity (PParams era))
-> NonNegativeInterval -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer
0 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"is not enforced when it is not set" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) ()
withoutPledgeInfluence
      (wellPledgedRewards, overLeveragedRewards) <- ImpTestM era (Coin, Coin)
forall era. DijkstraEraImp era => ImpTestM era (Coin, Coin)
rewardsOfWellAndOverPledgedPools
      wellPledgedRewards `shouldSatisfy` (> Coin 0)
      overLeveragedRewards `shouldBe` wellPledgedRewards

    String
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
"lowers the rewards of a pool that is leveraged beyond it" (ImpM (LedgerSpec era) ()
 -> SpecWith (Arg (ImpM (LedgerSpec era) ())))
-> ImpM (LedgerSpec era) ()
-> SpecWith (Arg (ImpM (LedgerSpec era) ()))
forall a b. (a -> b) -> a -> b
$ do
      ImpM (LedgerSpec era) ()
withoutPledgeInfluence
      (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall era.
ShelleyEraImp era =>
(PParams era -> PParams era) -> ImpTestM era ()
modifyPParams ((PParams era -> PParams era) -> ImpM (LedgerSpec era) ())
-> (PParams era -> PParams era) -> ImpM (LedgerSpec era) ()
forall a b. (a -> b) -> a -> b
$ \PParams era
pp ->
        PParams era
pp PParams era -> (PParams era -> PParams era) -> PParams era
forall a b. a -> (a -> b) -> b
& (MaxPledgeLeverage -> Identity MaxPledgeLeverage)
-> PParams era -> Identity (PParams era)
forall era.
DijkstraEraPParams era =>
Lens' (PParams era) MaxPledgeLeverage
Lens' (PParams era) MaxPledgeLeverage
ppMaxPledgeLeverageL ((MaxPledgeLeverage -> Identity MaxPledgeLeverage)
 -> PParams era -> Identity (PParams era))
-> MaxPledgeLeverage -> PParams era -> PParams era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ StrictMaybe NonNegativeInterval -> MaxPledgeLeverage
MaxPledgeLeverage (NonNegativeInterval -> StrictMaybe NonNegativeInterval
forall a. a -> StrictMaybe a
SJust (Integer
10 Integer -> Integer -> NonNegativeInterval
forall r. (IsRatio r, HasCallStack) => Integer -> Integer -> r
%! Integer
1))
      (wellPledgedRewards, overLeveragedRewards) <- ImpTestM era (Coin, Coin)
forall era. DijkstraEraImp era => ImpTestM era (Coin, Coin)
rewardsOfWellAndOverPledgedPools
      -- The leverage of the well pledged pool is exactly the maximum, so it is rewarded
      -- for all of its stake, just like it would have been without the cap.
      wellPledgedRewards `shouldSatisfy` (> Coin 0)
      -- The over-leveraged pool is only rewarded for ten times its pledge, which is a
      -- thousandth of the stake it actually has, so it earns roughly a thousandth of what
      -- the well pledged pool earns. It is not cut off from the rewards entirely.
      overLeveragedRewards `shouldSatisfy` (> Coin 0)
      Coin (100 * unCoin overLeveragedRewards) `shouldSatisfy` (< wellPledgedRewards)
  where
    registerNewPool :: ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool = do
      (kh, vrf) <- (,) (KeyHash StakePool
 -> VRFVerKeyHash StakePoolVRF
 -> (KeyHash StakePool, VRFVerKeyHash StakePoolVRF))
-> ImpM (LedgerSpec era) (KeyHash StakePool)
-> ImpM
     (LedgerSpec era)
     (VRFVerKeyHash StakePoolVRF
      -> (KeyHash StakePool, VRFVerKeyHash StakePoolVRF))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (KeyHash StakePool)
forall (r :: KeyRole) s g (m :: * -> *).
(HasKeyPairs s, MonadState s m, HasStatefulGen g m) =>
m (KeyHash r)
freshKeyHash ImpM
  (LedgerSpec era)
  (VRFVerKeyHash StakePoolVRF
   -> (KeyHash StakePool, VRFVerKeyHash StakePoolVRF))
-> ImpTestM era (VRFVerKeyHash StakePoolVRF)
-> ImpM
     (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
forall a b.
ImpM (LedgerSpec era) (a -> b)
-> ImpM (LedgerSpec era) a -> ImpM (LedgerSpec era) b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ImpTestM era (VRFVerKeyHash StakePoolVRF)
forall era (r :: KeyRoleVRF). ImpTestM era (VRFVerKeyHash r)
freshKeyHashVRF
      submitTx_ . registerPoolTx =<< poolParams kh vrf
      expectPool kh (Just vrf)
      pure (kh, vrf)
    registerPoolTx :: StakePoolParams era -> Tx l era
registerPoolTx StakePoolParams era
pps =
      TxBody l era -> Tx l era
forall era (l :: TxLevel). EraTx era => TxBody l era -> Tx l era
forall (l :: TxLevel). TxBody l era -> Tx l era
mkBasicTx TxBody l era
forall era (l :: TxLevel).
(EraTxBody era, Typeable l) =>
TxBody l era
forall (l :: TxLevel). Typeable l => TxBody l era
mkBasicTxBody
        Tx l era -> (Tx l era -> Tx l era) -> Tx l era
forall a b. a -> (a -> b) -> b
& (TxBody l era -> Identity (TxBody l era))
-> Tx l era -> Identity (Tx l era)
forall era (l :: TxLevel).
EraTx era =>
Lens' (Tx l era) (TxBody l era)
forall (l :: TxLevel). Lens' (Tx l era) (TxBody l era)
bodyTxL ((TxBody l era -> Identity (TxBody l era))
 -> Tx l era -> Identity (Tx l era))
-> ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
    -> TxBody l era -> Identity (TxBody l era))
-> (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> Tx l era
-> Identity (Tx l era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
-> TxBody l era -> Identity (TxBody l era)
forall era (l :: TxLevel).
EraTxBody era =>
Lens' (TxBody l era) (StrictSeq (TxCert era))
forall (l :: TxLevel).
Lens' (TxBody l era) (StrictSeq (TxCert era))
certsTxBodyL ((StrictSeq (TxCert era) -> Identity (StrictSeq (TxCert era)))
 -> Tx l era -> Identity (Tx l era))
-> StrictSeq (TxCert era) -> Tx l era -> Tx l era
forall s t a b. ASetter s t a b -> b -> s -> t
.~ TxCert era -> StrictSeq (TxCert era)
forall a. a -> StrictSeq a
SSeq.singleton (StakePoolParams era -> TxCert era
forall era. EraTxCert era => StakePoolParams era -> TxCert era
RegPoolTxCert StakePoolParams era
pps)
    -- Two pools can only share a VRF if both registered it before VRFs had to be
    -- unique, in which case the hard fork to protocol version 11 recorded the VRF
    -- with a count of two. Registering a pool and then rewriting its VRF puts the
    -- state into the same shape.
    registerPoolSharingVRF :: VRFVerKeyHash StakePoolVRF
-> ImpM (LedgerSpec era) (KeyHash StakePool)
registerPoolSharingVRF VRFVerKeyHash StakePoolVRF
vrf = do
      (kh, ownVrf) <- ImpM
  (LedgerSpec era) (KeyHash StakePool, VRFVerKeyHash StakePoolVRF)
registerNewPool
      modifyNES $
        nesEsL . esLStateL . lsCertStateL . certPStateL %~ \PState era
ps ->
          PState era
ps
            PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Map (KeyHash StakePool) StakePoolState
 -> Identity (Map (KeyHash StakePool) StakePoolState))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolState
 -> f (Map (KeyHash StakePool) StakePoolState))
-> PState era -> f (PState era)
psStakePoolsL ((Map (KeyHash StakePool) StakePoolState
  -> Identity (Map (KeyHash StakePool) StakePoolState))
 -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) StakePoolState
    -> Map (KeyHash StakePool) StakePoolState)
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (StakePoolState -> StakePoolState)
-> KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall k a. Ord k => (a -> a) -> k -> Map k a -> Map k a
Map.adjust ((VRFVerKeyHash StakePoolVRF
 -> Identity (VRFVerKeyHash StakePoolVRF))
-> StakePoolState -> Identity StakePoolState
Lens' StakePoolState (VRFVerKeyHash StakePoolVRF)
spsVrfL ((VRFVerKeyHash StakePoolVRF
  -> Identity (VRFVerKeyHash StakePoolVRF))
 -> StakePoolState -> Identity StakePoolState)
-> VRFVerKeyHash StakePoolVRF -> StakePoolState -> StakePoolState
forall s t a b. ASetter s t a b -> b -> s -> t
.~ VRFVerKeyHash StakePoolVRF
vrf) KeyHash StakePool
kh
            PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Identity (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> f (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
-> PState era -> f (PState era)
psVRFKeyHashesL ((Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
  -> Identity (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)))
 -> PState era -> Identity (PState era))
-> (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
    -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ VRFVerKeyHash StakePoolVRF
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
addVRFKeyHashOccurrence VRFVerKeyHash StakePoolVRF
vrf (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
 -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
    -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VRFVerKeyHash StakePoolVRF
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete VRFVerKeyHash StakePoolVRF
ownVrf
      expectPool kh (Just vrf)
      pure kh
    retirePoolTx :: KeyHash StakePool
-> EpochInterval -> ImpM (LedgerSpec era) (Tx l era)
retirePoolTx KeyHash StakePool
kh EpochInterval
retirementInterval = do
      curEpochNo <- SimpleGetter (NewEpochState era) EpochNo -> ImpTestM era EpochNo
forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES (EpochNo -> Const r EpochNo)
-> NewEpochState era -> Const r (NewEpochState era)
SimpleGetter (NewEpochState era) EpochNo
forall era (f :: * -> *).
Functor f =>
(EpochNo -> f EpochNo)
-> NewEpochState era -> f (NewEpochState era)
nesELL
      pure $
        mkBasicTx mkBasicTxBody
          & bodyTxL . certsTxBodyL
            .~ SSeq.singleton (RetirePoolTxCert kh (addEpochInterval curEpochNo retirementInterval))
    expectPool :: KeyHash StakePool
-> Maybe (VRFVerKeyHash StakePoolVRF) -> ImpM (LedgerSpec era) ()
expectPool KeyHash StakePool
poolKh Maybe (VRFVerKeyHash StakePoolVRF)
mbVrf = do
      pools <- PState era -> Map (KeyHash StakePool) StakePoolState
forall era. PState era -> Map (KeyHash StakePool) StakePoolState
psStakePools (PState era -> Map (KeyHash StakePool) StakePoolState)
-> ImpM (LedgerSpec era) (PState era)
-> ImpM (LedgerSpec era) (Map (KeyHash StakePool) StakePoolState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (PState era)
getPState
      spsVrf <$> Map.lookup poolKh pools `shouldBe` mbVrf
    expectFuturePool :: KeyHash StakePool
-> Maybe (VRFVerKeyHash StakePoolVRF) -> ImpM (LedgerSpec era) ()
expectFuturePool KeyHash StakePool
poolKh Maybe (VRFVerKeyHash StakePoolVRF)
mbVrf = do
      fps <- PState era -> Map (KeyHash StakePool) (StakePoolParams era)
forall era.
PState era -> Map (KeyHash StakePool) (StakePoolParams era)
psFutureStakePoolParams (PState era -> Map (KeyHash StakePool) (StakePoolParams era))
-> ImpM (LedgerSpec era) (PState era)
-> ImpM
     (LedgerSpec era) (Map (KeyHash StakePool) (StakePoolParams era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (PState era)
getPState
      sppVrf <$> Map.lookup poolKh fps `shouldBe` mbVrf
    expectVRFs :: [(VRFVerKeyHash StakePoolVRF, Word64)] -> ImpM (LedgerSpec era) ()
expectVRFs [(VRFVerKeyHash StakePoolVRF, Word64)]
vrfs =
      PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall era.
PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes
        (PState era -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> ImpM (LedgerSpec era) (PState era)
-> ImpM
     (LedgerSpec era)
     (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ImpM (LedgerSpec era) (PState era)
getPState
          ImpM
  (LedgerSpec era)
  (Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64))
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> ImpM (LedgerSpec era) ()
forall (m :: * -> *) a.
(HasCallStack, MonadIO m, Show a, Eq a) =>
m a -> a -> m ()
`shouldReturn` [(VRFVerKeyHash StakePoolVRF, NonZero Word64)]
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(VRFVerKeyHash StakePoolVRF
vrf, Word64 -> NonZero Word64
forall a. a -> NonZero a
unsafeNonZero Word64
n) | (VRFVerKeyHash StakePoolVRF
vrf, Word64
n) <- [(VRFVerKeyHash StakePoolVRF, Word64)]
vrfs]
    poolParams ::
      KeyHash StakePool ->
      VRFVerKeyHash StakePoolVRF ->
      ImpTestM era (StakePoolParams era)
    poolParams :: KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF
-> ImpM (LedgerSpec era) (StakePoolParams era)
poolParams KeyHash StakePool
kh VRFVerKeyHash StakePoolVRF
vrf = do
      pps <- ImpTestM era AccountAddress
forall era.
(HasCallStack, ShelleyEraImp era) =>
ImpTestM era AccountAddress
registerAccountAddress ImpTestM era AccountAddress
-> (AccountAddress -> ImpM (LedgerSpec era) (StakePoolParams era))
-> ImpM (LedgerSpec era) (StakePoolParams era)
forall a b.
ImpM (LedgerSpec era) a
-> (a -> ImpM (LedgerSpec era) b) -> ImpM (LedgerSpec era) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= KeyHash StakePool
-> AccountAddress -> ImpM (LedgerSpec era) (StakePoolParams era)
forall era.
ShelleyEraImp era =>
KeyHash StakePool
-> AccountAddress -> ImpTestM era (StakePoolParams era)
freshPoolParams KeyHash StakePool
kh
      pure $ pps & sppVrfL .~ vrf
    getPState :: ImpM (LedgerSpec era) (PState era)
getPState = forall era a. SimpleGetter (NewEpochState era) a -> ImpTestM era a
getsNES @era (SimpleGetter (NewEpochState era) (PState era)
 -> ImpM (LedgerSpec era) (PState era))
-> SimpleGetter (NewEpochState era) (PState era)
-> ImpM (LedgerSpec era) (PState era)
forall a b. (a -> b) -> a -> b
$ (EpochState era -> Const r (EpochState era))
-> NewEpochState era -> Const r (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const r (EpochState era))
 -> NewEpochState era -> Const r (NewEpochState era))
-> ((PState era -> Const r (PState era))
    -> EpochState era -> Const r (EpochState era))
-> (PState era -> Const r (PState era))
-> NewEpochState era
-> Const r (NewEpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const r (LedgerState era))
-> EpochState era -> Const r (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const r (LedgerState era))
 -> EpochState era -> Const r (EpochState era))
-> ((PState era -> Const r (PState era))
    -> LedgerState era -> Const r (LedgerState era))
-> (PState era -> Const r (PState era))
-> EpochState era
-> Const r (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CertState era -> Const r (CertState era))
-> LedgerState era -> Const r (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(CertState era -> f (CertState era))
-> LedgerState era -> f (LedgerState era)
lsCertStateL ((CertState era -> Const r (CertState era))
 -> LedgerState era -> Const r (LedgerState era))
-> ((PState era -> Const r (PState era))
    -> CertState era -> Const r (CertState era))
-> (PState era -> Const r (PState era))
-> LedgerState era
-> Const r (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PState era -> Const r (PState era))
-> CertState era -> Const r (CertState era)
forall era. EraCertState era => Lens' (CertState era) (PState era)
Lens' (CertState era) (PState era)
certPStateL