{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Cardano.Ledger.Shelley.Rules.Pool (
  ShelleyPOOL,
  PoolEvent (..),
  PoolEnv (..),
  PredicateFailure,
  ShelleyPoolPredFailure (..),
) where

import Cardano.Crypto.Hash.Class (sizeHash)
import Cardano.Ledger.Address (raNetwork)
import Cardano.Ledger.BaseTypes (
  EpochNo,
  Globals (..),
  Mismatch (..),
  Network,
  Relation (..),
  ShelleyBase,
  addEpochInterval,
  invalidKey,
  knownNonZeroBounded,
  networkId,
 )
import Cardano.Ledger.Binary (
  DecCBOR (..),
  EncCBOR (..),
  decodeRecordSum,
  encodeListLen,
 )
import Cardano.Ledger.Binary.Coders (Encode (..), encode, (!>))
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.Era (
  ShelleyEra,
  ShelleyPOOL,
  hardforkAlonzoValidatePoolRewardAccountNetID,
  hardforkConwayDisallowDuplicatedVRFKeys,
 )
import qualified Cardano.Ledger.Shelley.SoftForks as SoftForks
import Cardano.Ledger.State
import Control.DeepSeq
import Control.Monad (forM_, when)
import Control.Monad.Trans.Reader (asks)
import Control.State.Transition (
  STS (..),
  TRC (..),
  TransitionRule,
  judgmentContext,
  liftSTS,
  tellEvent,
  (?!),
 )
import qualified Data.ByteString as BS
import Data.Kind (Type)
import qualified Data.Map as Map
import Data.Word (Word8)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))

data PoolEnv era
  = PoolEnv EpochNo (PParams era)
  deriving ((forall x. PoolEnv era -> Rep (PoolEnv era) x)
-> (forall x. Rep (PoolEnv era) x -> PoolEnv era)
-> Generic (PoolEnv era)
forall x. Rep (PoolEnv era) x -> PoolEnv era
forall x. PoolEnv era -> Rep (PoolEnv era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PoolEnv era) x -> PoolEnv era
forall era x. PoolEnv era -> Rep (PoolEnv era) x
$cfrom :: forall era x. PoolEnv era -> Rep (PoolEnv era) x
from :: forall x. PoolEnv era -> Rep (PoolEnv era) x
$cto :: forall era x. Rep (PoolEnv era) x -> PoolEnv era
to :: forall x. Rep (PoolEnv era) x -> PoolEnv era
Generic)

instance EraPParams era => EncCBOR (PoolEnv era) where
  encCBOR :: PoolEnv era -> Encoding
encCBOR (PoolEnv EpochNo
e PParams era
pp) =
    Encode (Closed Dense) (PoolEnv era) -> Encoding
forall (w :: Wrapped) t. Encode w t -> Encoding
encode (Encode (Closed Dense) (PoolEnv era) -> Encoding)
-> Encode (Closed Dense) (PoolEnv era) -> Encoding
forall a b. (a -> b) -> a -> b
$
      (EpochNo -> PParams era -> PoolEnv era)
-> Encode (Closed Dense) (EpochNo -> PParams era -> PoolEnv era)
forall t. t -> Encode (Closed Dense) t
Rec EpochNo -> PParams era -> PoolEnv era
forall era. EpochNo -> PParams era -> PoolEnv era
PoolEnv
        Encode (Closed Dense) (EpochNo -> PParams era -> PoolEnv era)
-> Encode (Closed Dense) EpochNo
-> Encode (Closed Dense) (PParams era -> PoolEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> EpochNo -> Encode (Closed Dense) EpochNo
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To EpochNo
e
        Encode (Closed Dense) (PParams era -> PoolEnv era)
-> Encode (Closed Dense) (PParams era)
-> Encode (Closed Dense) (PoolEnv era)
forall (w :: Wrapped) a t (r :: Density).
Encode w (a -> t) -> Encode (Closed r) a -> Encode w t
!> PParams era -> Encode (Closed Dense) (PParams era)
forall t. EncCBOR t => t -> Encode (Closed Dense) t
To PParams era
pp

deriving instance Show (PParams era) => Show (PoolEnv era)

deriving instance Eq (PParams era) => Eq (PoolEnv era)

instance NFData (PParams era) => NFData (PoolEnv era)

data ShelleyPoolPredFailure era
  = StakePoolNotRegisteredOnKeyPOOL
      -- | KeyHash which cannot be retired since it is not registered
      (KeyHash StakePool)
  | StakePoolRetirementWrongEpochPOOL
      (Mismatch RelGT EpochNo)
      (Mismatch RelLTEQ EpochNo)
  | StakePoolCostTooLowPOOL
      (Mismatch RelGTEQ Coin)
  | WrongNetworkPOOL
      (Mismatch RelEQ Network)
      -- | Stake Pool ID
      (KeyHash StakePool)
  | PoolMedataHashTooBig
      -- | Stake Pool ID
      (KeyHash StakePool)
      -- | Size of the metadata hash
      Int
  | VRFKeyHashAlreadyRegistered
      -- | Stake Pool ID
      (KeyHash StakePool)
      -- | VRF key attempted to use, that has already been registered
      (VRFVerKeyHash StakePoolVRF)
  deriving (ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool
(ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool)
-> (ShelleyPoolPredFailure era
    -> ShelleyPoolPredFailure era -> Bool)
-> Eq (ShelleyPoolPredFailure era)
forall era.
ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era.
ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool
== :: ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool
$c/= :: forall era.
ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool
/= :: ShelleyPoolPredFailure era -> ShelleyPoolPredFailure era -> Bool
Eq, Int -> ShelleyPoolPredFailure era -> ShowS
[ShelleyPoolPredFailure era] -> ShowS
ShelleyPoolPredFailure era -> String
(Int -> ShelleyPoolPredFailure era -> ShowS)
-> (ShelleyPoolPredFailure era -> String)
-> ([ShelleyPoolPredFailure era] -> ShowS)
-> Show (ShelleyPoolPredFailure era)
forall era. Int -> ShelleyPoolPredFailure era -> ShowS
forall era. [ShelleyPoolPredFailure era] -> ShowS
forall era. ShelleyPoolPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: forall era. Int -> ShelleyPoolPredFailure era -> ShowS
showsPrec :: Int -> ShelleyPoolPredFailure era -> ShowS
$cshow :: forall era. ShelleyPoolPredFailure era -> String
show :: ShelleyPoolPredFailure era -> String
$cshowList :: forall era. [ShelleyPoolPredFailure era] -> ShowS
showList :: [ShelleyPoolPredFailure era] -> ShowS
Show, (forall x.
 ShelleyPoolPredFailure era -> Rep (ShelleyPoolPredFailure era) x)
-> (forall x.
    Rep (ShelleyPoolPredFailure era) x -> ShelleyPoolPredFailure era)
-> Generic (ShelleyPoolPredFailure era)
forall x.
Rep (ShelleyPoolPredFailure era) x -> ShelleyPoolPredFailure era
forall x.
ShelleyPoolPredFailure era -> Rep (ShelleyPoolPredFailure era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyPoolPredFailure era) x -> ShelleyPoolPredFailure era
forall era x.
ShelleyPoolPredFailure era -> Rep (ShelleyPoolPredFailure era) x
$cfrom :: forall era x.
ShelleyPoolPredFailure era -> Rep (ShelleyPoolPredFailure era) x
from :: forall x.
ShelleyPoolPredFailure era -> Rep (ShelleyPoolPredFailure era) x
$cto :: forall era x.
Rep (ShelleyPoolPredFailure era) x -> ShelleyPoolPredFailure era
to :: forall x.
Rep (ShelleyPoolPredFailure era) x -> ShelleyPoolPredFailure era
Generic)

type instance EraRuleFailure "POOL" ShelleyEra = ShelleyPoolPredFailure ShelleyEra

instance InjectRuleFailure "POOL" ShelleyPoolPredFailure ShelleyEra

instance NoThunks (ShelleyPoolPredFailure era)

instance NFData (ShelleyPoolPredFailure era)

instance EraPParams era => STS (ShelleyPOOL era) where
  type State (ShelleyPOOL era) = PState era

  type Signal (ShelleyPOOL era) = PoolCert

  type Environment (ShelleyPOOL era) = PoolEnv era

  type BaseM (ShelleyPOOL era) = ShelleyBase
  type PredicateFailure (ShelleyPOOL era) = ShelleyPoolPredFailure era
  type Event (ShelleyPOOL era) = PoolEvent era

  transitionRules :: [TransitionRule (ShelleyPOOL era)]
transitionRules = [TransitionRule (ShelleyPOOL era)
forall (ledger :: * -> *) era.
(EraPParams era, Signal (ledger era) ~ PoolCert,
 Environment (ledger era) ~ PoolEnv era,
 State (ledger era) ~ PState era, STS (ledger era),
 Event (ledger era) ~ PoolEvent era,
 BaseM (ledger era) ~ ShelleyBase,
 PredicateFailure (ledger era) ~ ShelleyPoolPredFailure era) =>
TransitionRule (ledger era)
poolDelegationTransition]

data PoolEvent era
  = RegisterPool (KeyHash StakePool)
  | ReregisterPool (KeyHash StakePool)
  deriving ((forall x. PoolEvent era -> Rep (PoolEvent era) x)
-> (forall x. Rep (PoolEvent era) x -> PoolEvent era)
-> Generic (PoolEvent era)
forall x. Rep (PoolEvent era) x -> PoolEvent era
forall x. PoolEvent era -> Rep (PoolEvent era) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x. Rep (PoolEvent era) x -> PoolEvent era
forall era x. PoolEvent era -> Rep (PoolEvent era) x
$cfrom :: forall era x. PoolEvent era -> Rep (PoolEvent era) x
from :: forall x. PoolEvent era -> Rep (PoolEvent era) x
$cto :: forall era x. Rep (PoolEvent era) x -> PoolEvent era
to :: forall x. Rep (PoolEvent era) x -> PoolEvent era
Generic, PoolEvent era -> PoolEvent era -> Bool
(PoolEvent era -> PoolEvent era -> Bool)
-> (PoolEvent era -> PoolEvent era -> Bool) -> Eq (PoolEvent era)
forall era. PoolEvent era -> PoolEvent era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: forall era. PoolEvent era -> PoolEvent era -> Bool
== :: PoolEvent era -> PoolEvent era -> Bool
$c/= :: forall era. PoolEvent era -> PoolEvent era -> Bool
/= :: PoolEvent era -> PoolEvent era -> Bool
Eq)

instance NFData (PoolEvent era)

instance Era era => EncCBOR (ShelleyPoolPredFailure era) where
  encCBOR :: ShelleyPoolPredFailure era -> Encoding
encCBOR = \case
    StakePoolNotRegisteredOnKeyPOOL KeyHash StakePool
kh ->
      Word -> Encoding
encodeListLen Word
2 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
0 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash StakePool
kh
    StakePoolRetirementWrongEpochPOOL (Mismatch EpochNo
_ EpochNo
gtExpected) (Mismatch EpochNo
ltSupplied EpochNo
ltExpected) ->
      Word -> Encoding
encodeListLen Word
4
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
1 :: Word8)
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EpochNo
gtExpected
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EpochNo
ltSupplied
        Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> EpochNo -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR EpochNo
ltExpected
    StakePoolCostTooLowPOOL (Mismatch Coin
supplied Coin
expected) ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
3 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
supplied Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Coin -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Coin
expected
    WrongNetworkPOOL (Mismatch Network
supplied Network
expected) KeyHash StakePool
c ->
      Word -> Encoding
encodeListLen Word
4 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
4 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Network -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Network
expected Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Network -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Network
supplied Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash StakePool
c
    PoolMedataHashTooBig KeyHash StakePool
a Int
b ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
5 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash StakePool
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Int -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR Int
b
    VRFKeyHashAlreadyRegistered KeyHash StakePool
a VRFVerKeyHash StakePoolVRF
b ->
      Word -> Encoding
encodeListLen Word
3 Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word8 -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR (Word8
6 :: Word8) Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> KeyHash StakePool -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR KeyHash StakePool
a Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> VRFVerKeyHash StakePoolVRF -> Encoding
forall a. EncCBOR a => a -> Encoding
encCBOR VRFVerKeyHash StakePoolVRF
b

-- `ShelleyPoolPredFailure` is used in Conway POOL rule, so we need to keep the serialization unchanged
instance Era era => DecCBOR (ShelleyPoolPredFailure era) where
  decCBOR :: forall s. Decoder s (ShelleyPoolPredFailure era)
decCBOR = Text
-> (Word -> Decoder s (Int, ShelleyPoolPredFailure era))
-> Decoder s (ShelleyPoolPredFailure era)
forall s a. Text -> (Word -> Decoder s (Int, a)) -> Decoder s a
decodeRecordSum Text
"PredicateFailure (POOL era)" ((Word -> Decoder s (Int, ShelleyPoolPredFailure era))
 -> Decoder s (ShelleyPoolPredFailure era))
-> (Word -> Decoder s (Int, ShelleyPoolPredFailure era))
-> Decoder s (ShelleyPoolPredFailure era)
forall a b. (a -> b) -> a -> b
$
    \case
      Word
0 -> do
        kh <- Decoder s (KeyHash StakePool)
forall s. Decoder s (KeyHash StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR
        pure (2, StakePoolNotRegisteredOnKeyPOOL kh)
      Word
1 -> do
        gtExpected <- Decoder s EpochNo
forall s. Decoder s EpochNo
forall a s. DecCBOR a => Decoder s a
decCBOR
        ltSupplied <- decCBOR
        ltExpected <- decCBOR
        pure
          ( 4
          , StakePoolRetirementWrongEpochPOOL
              (Mismatch ltSupplied gtExpected)
              (Mismatch ltSupplied ltExpected)
          )
      Word
2 -> String -> Decoder s (Int, ShelleyPoolPredFailure era)
forall a. String -> Decoder s a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"WrongCertificateTypePOOL has been removed as impossible case"
      Word
3 -> do
        supplied <- Decoder s Coin
forall s. Decoder s Coin
forall a s. DecCBOR a => Decoder s a
decCBOR
        expected <- decCBOR
        pure (3, StakePoolCostTooLowPOOL (Mismatch supplied expected))
      Word
4 -> do
        expectedNetId <- Decoder s Network
forall s. Decoder s Network
forall a s. DecCBOR a => Decoder s a
decCBOR
        suppliedNetId <- decCBOR
        poolId <- decCBOR
        pure (4, WrongNetworkPOOL (Mismatch suppliedNetId expectedNetId) poolId)
      Word
5 -> do
        poolID <- Decoder s (KeyHash StakePool)
forall s. Decoder s (KeyHash StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR
        s <- decCBOR
        pure (3, PoolMedataHashTooBig poolID s)
      Word
6 -> do
        poolID <- Decoder s (KeyHash StakePool)
forall s. Decoder s (KeyHash StakePool)
forall a s. DecCBOR a => Decoder s a
decCBOR
        vrfKeyHash <- decCBOR
        pure (3, VRFKeyHashAlreadyRegistered poolID vrfKeyHash)
      Word
k -> Word -> Decoder s (Int, ShelleyPoolPredFailure era)
forall a (m :: * -> *). (Typeable a, MonadFail m) => Word -> m a
invalidKey Word
k

poolDelegationTransition ::
  forall (ledger :: Type -> Type) era.
  ( EraPParams era
  , Signal (ledger era) ~ PoolCert
  , Environment (ledger era) ~ PoolEnv era
  , State (ledger era) ~ PState era
  , STS (ledger era)
  , Event (ledger era) ~ PoolEvent era
  , BaseM (ledger era) ~ ShelleyBase
  , PredicateFailure (ledger era) ~ ShelleyPoolPredFailure era
  ) =>
  TransitionRule (ledger era)
poolDelegationTransition :: forall (ledger :: * -> *) era.
(EraPParams era, Signal (ledger era) ~ PoolCert,
 Environment (ledger era) ~ PoolEnv era,
 State (ledger era) ~ PState era, STS (ledger era),
 Event (ledger era) ~ PoolEvent era,
 BaseM (ledger era) ~ ShelleyBase,
 PredicateFailure (ledger era) ~ ShelleyPoolPredFailure era) =>
TransitionRule (ledger era)
poolDelegationTransition = do
  TRC
    ( PoolEnv cEpoch pp
      , ps@PState {psStakePools, psFutureStakePoolParams, psVRFKeyHashes}
      , poolCert
      ) <-
    Rule
  (ledger era) 'Transition (RuleContext 'Transition (ledger era))
F (Clause (ledger era) 'Transition) (TRC (ledger era))
forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
  case poolCert of
    RegPool stakePoolParams :: StakePoolParams
stakePoolParams@StakePoolParams {KeyHash StakePool
sppId :: KeyHash StakePool
sppId :: StakePoolParams -> KeyHash StakePool
sppId, VRFVerKeyHash StakePoolVRF
sppVrf :: VRFVerKeyHash StakePoolVRF
sppVrf :: StakePoolParams -> VRFVerKeyHash StakePoolVRF
sppVrf, RewardAccount
sppRewardAccount :: RewardAccount
sppRewardAccount :: StakePoolParams -> RewardAccount
sppRewardAccount, StrictMaybe PoolMetadata
sppMetadata :: StrictMaybe PoolMetadata
sppMetadata :: StakePoolParams -> StrictMaybe PoolMetadata
sppMetadata, Coin
sppCost :: Coin
sppCost :: StakePoolParams -> Coin
sppCost} -> do
      let pv :: ProtVer
pv = PParams era
pp PParams era -> Getting ProtVer (PParams era) ProtVer -> ProtVer
forall s a. s -> Getting a s a -> a
^. Getting ProtVer (PParams era) ProtVer
forall era. EraPParams era => Lens' (PParams era) ProtVer
Lens' (PParams era) ProtVer
ppProtocolVersionL
      Bool
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer -> Bool
hardforkAlonzoValidatePoolRewardAccountNetID ProtVer
pv) (F (Clause (ledger era) 'Transition) ()
 -> F (Clause (ledger era) 'Transition) ())
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ do
        actualNetID <- BaseM (ledger era) Network -> Rule (ledger era) 'Transition Network
forall sts a (ctx :: RuleType).
STS sts =>
BaseM sts a -> Rule sts ctx a
liftSTS (BaseM (ledger era) Network
 -> Rule (ledger era) 'Transition Network)
-> BaseM (ledger era) Network
-> Rule (ledger era) 'Transition Network
forall a b. (a -> b) -> a -> b
$ (Globals -> Network) -> ReaderT Globals Identity Network
forall (m :: * -> *) r a. Monad m => (r -> a) -> ReaderT r m a
asks Globals -> Network
networkId
        let suppliedNetID = RewardAccount -> Network
raNetwork RewardAccount
sppRewardAccount
        actualNetID
          == suppliedNetID
            ?! WrongNetworkPOOL
              Mismatch
                { mismatchSupplied = suppliedNetID
                , mismatchExpected = actualNetID
                }
              sppId

      Bool
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer -> Bool
SoftForks.restrictPoolMetadataHash ProtVer
pv) (F (Clause (ledger era) 'Transition) ()
 -> F (Clause (ledger era) 'Transition) ())
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$
        StrictMaybe PoolMetadata
-> (PoolMetadata -> F (Clause (ledger era) 'Transition) ())
-> F (Clause (ledger era) 'Transition) ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ StrictMaybe PoolMetadata
sppMetadata ((PoolMetadata -> F (Clause (ledger era) 'Transition) ())
 -> F (Clause (ledger era) 'Transition) ())
-> (PoolMetadata -> F (Clause (ledger era) 'Transition) ())
-> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ \PoolMetadata
pmd ->
          let s :: Int
s = ByteString -> Int
BS.length (PoolMetadata -> ByteString
pmHash PoolMetadata
pmd)
           in Int
s
                Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([HASH] -> Word
forall h (proxy :: * -> *). HashAlgorithm h => proxy h -> Word
sizeHash ([] @HASH))
                  Bool
-> PredicateFailure (ledger era)
-> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! KeyHash StakePool -> Int -> ShelleyPoolPredFailure era
forall era. KeyHash StakePool -> Int -> ShelleyPoolPredFailure era
PoolMedataHashTooBig KeyHash StakePool
sppId Int
s

      let minPoolCost :: Coin
minPoolCost = PParams era
pp PParams era -> Getting Coin (PParams era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (PParams era) Coin
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams era) Coin
ppMinPoolCostL
      Coin
sppCost
        Coin -> Coin -> Bool
forall a. Ord a => a -> a -> Bool
>= Coin
minPoolCost
          Bool
-> PredicateFailure (ledger era)
-> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Mismatch RelGTEQ Coin -> ShelleyPoolPredFailure era
forall era. Mismatch RelGTEQ Coin -> ShelleyPoolPredFailure era
StakePoolCostTooLowPOOL
            Mismatch
              { mismatchSupplied :: Coin
mismatchSupplied = Coin
sppCost
              , mismatchExpected :: Coin
mismatchExpected = Coin
minPoolCost
              }
      case KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolState -> Maybe StakePoolState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash StakePool
sppId Map (KeyHash StakePool) StakePoolState
psStakePools of
        -- register new, Pool-Reg
        Maybe StakePoolState
Nothing -> do
          Bool
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer -> Bool
hardforkConwayDisallowDuplicatedVRFKeys ProtVer
pv) (F (Clause (ledger era) 'Transition) ()
 -> F (Clause (ledger era) 'Transition) ())
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ do
            VRFVerKeyHash StakePoolVRF
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember VRFVerKeyHash StakePoolVRF
sppVrf Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes Bool
-> PredicateFailure (ledger era)
-> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
forall era.
KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
VRFKeyHashAlreadyRegistered KeyHash StakePool
sppId VRFVerKeyHash StakePoolVRF
sppVrf
          let updateVRFKeyHash :: Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
updateVRFKeyHash
                | ProtVer -> Bool
hardforkConwayDisallowDuplicatedVRFKeys ProtVer
pv = VRFVerKeyHash StakePoolVRF
-> NonZero Word64
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert VRFVerKeyHash StakePoolVRF
sppVrf (forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @1)
                | Bool
otherwise = Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall a. a -> a
id
          Event (ledger era) -> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ledger era) -> F (Clause (ledger era) 'Transition) ())
-> Event (ledger era) -> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool -> PoolEvent era
forall era. KeyHash StakePool -> PoolEvent era
RegisterPool KeyHash StakePool
sppId
          PState era -> F (Clause (ledger era) 'Transition) (PState era)
forall a. a -> F (Clause (ledger era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PState era -> F (Clause (ledger era) 'Transition) (PState era))
-> PState era -> F (Clause (ledger era) 'Transition) (PState era)
forall a b. (a -> b) -> a -> b
$
            PState era
State (ledger 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
%~ KeyHash StakePool
-> StakePoolState
-> Map (KeyHash StakePool) StakePoolState
-> Map (KeyHash StakePool) StakePoolState
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash StakePool
sppId (CompactForm Coin
-> Set (Credential Staking) -> StakePoolParams -> StakePoolState
mkStakePoolState (PParams era
pp PParams era
-> Getting (CompactForm Coin) (PParams era) (CompactForm Coin)
-> CompactForm Coin
forall s a. s -> Getting a s a -> a
^. Getting (CompactForm Coin) (PParams era) (CompactForm Coin)
forall era.
EraPParams era =>
Lens' (PParams era) (CompactForm Coin)
Lens' (PParams era) (CompactForm Coin)
ppPoolDepositCompactL) Set (Credential Staking)
forall a. Monoid a => a
mempty StakePoolParams
stakePoolParams)
              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
%~ Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
updateVRFKeyHash
        -- re-register Pool
        Just StakePoolState
stakePoolState -> do
          Bool
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ProtVer -> Bool
hardforkConwayDisallowDuplicatedVRFKeys ProtVer
pv) (F (Clause (ledger era) 'Transition) ()
 -> F (Clause (ledger era) 'Transition) ())
-> F (Clause (ledger era) 'Transition) ()
-> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ do
            VRFVerKeyHash StakePoolVRF
sppVrf VRFVerKeyHash StakePoolVRF -> VRFVerKeyHash StakePoolVRF -> Bool
forall a. Eq a => a -> a -> Bool
== StakePoolState
stakePoolState StakePoolState
-> Getting
     (VRFVerKeyHash StakePoolVRF)
     StakePoolState
     (VRFVerKeyHash StakePoolVRF)
-> VRFVerKeyHash StakePoolVRF
forall s a. s -> Getting a s a -> a
^. Getting
  (VRFVerKeyHash StakePoolVRF)
  StakePoolState
  (VRFVerKeyHash StakePoolVRF)
Lens' StakePoolState (VRFVerKeyHash StakePoolVRF)
spsVrfL
              Bool -> Bool -> Bool
|| VRFVerKeyHash StakePoolVRF
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64) -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember VRFVerKeyHash StakePoolVRF
sppVrf Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
psVRFKeyHashes Bool
-> PredicateFailure (ledger era)
-> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
forall era.
KeyHash StakePool
-> VRFVerKeyHash StakePoolVRF -> ShelleyPoolPredFailure era
VRFKeyHashAlreadyRegistered KeyHash StakePool
sppId VRFVerKeyHash StakePoolVRF
sppVrf
          let updateFutureVRFKeyHash :: Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
updateFutureVRFKeyHash
                | ProtVer -> Bool
hardforkConwayDisallowDuplicatedVRFKeys ProtVer
pv =
                    -- If a pool re-registers with a fresh VRF, we have to record it in the map,
                    -- but also remove the previous VRFHashKey potentially stored in previous re-registration within the same epoch,
                    -- which we retrieve from futureStakePools.
                    case KeyHash StakePool
-> Map (KeyHash StakePool) StakePoolParams -> Maybe StakePoolParams
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup KeyHash StakePool
sppId Map (KeyHash StakePool) StakePoolParams
psFutureStakePoolParams of
                      Maybe StakePoolParams
Nothing -> VRFVerKeyHash StakePoolVRF
-> NonZero Word64
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert VRFVerKeyHash StakePoolVRF
sppVrf (forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @1)
                      Just StakePoolParams
futureStakePoolParams
                        | StakePoolParams
futureStakePoolParams StakePoolParams
-> Getting
     (VRFVerKeyHash StakePoolVRF)
     StakePoolParams
     (VRFVerKeyHash StakePoolVRF)
-> VRFVerKeyHash StakePoolVRF
forall s a. s -> Getting a s a -> a
^. Getting
  (VRFVerKeyHash StakePoolVRF)
  StakePoolParams
  (VRFVerKeyHash StakePoolVRF)
Lens' StakePoolParams (VRFVerKeyHash StakePoolVRF)
sppVrfL VRFVerKeyHash StakePoolVRF -> VRFVerKeyHash StakePoolVRF -> Bool
forall a. Eq a => a -> a -> Bool
/= VRFVerKeyHash StakePoolVRF
sppVrf ->
                            VRFVerKeyHash StakePoolVRF
-> NonZero Word64
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert VRFVerKeyHash StakePoolVRF
sppVrf (forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @1)
                              (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 (StakePoolParams
futureStakePoolParams StakePoolParams
-> Getting
     (VRFVerKeyHash StakePoolVRF)
     StakePoolParams
     (VRFVerKeyHash StakePoolVRF)
-> VRFVerKeyHash StakePoolVRF
forall s a. s -> Getting a s a -> a
^. Getting
  (VRFVerKeyHash StakePoolVRF)
  StakePoolParams
  (VRFVerKeyHash StakePoolVRF)
Lens' StakePoolParams (VRFVerKeyHash StakePoolVRF)
sppVrfL)
                        | Bool
otherwise -> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall a. a -> a
id
                | Bool
otherwise = Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
forall a. a -> a
id
          Event (ledger era) -> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent (Event (ledger era) -> F (Clause (ledger era) 'Transition) ())
-> Event (ledger era) -> F (Clause (ledger era) 'Transition) ()
forall a b. (a -> b) -> a -> b
$ KeyHash StakePool -> PoolEvent era
forall era. KeyHash StakePool -> PoolEvent era
ReregisterPool KeyHash StakePool
sppId
          -- This `sppId` is already registered, so we want to reregister it.
          -- That means adding it to the futureStakePoolParams or overriding it  with the new 'poolParams'.
          -- We must also unretire it, if it has been scheduled for retirement.
          -- The deposit does not change.
          PState era -> F (Clause (ledger era) 'Transition) (PState era)
forall a. a -> F (Clause (ledger era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PState era -> F (Clause (ledger era) 'Transition) (PState era))
-> PState era -> F (Clause (ledger era) 'Transition) (PState era)
forall a b. (a -> b) -> a -> b
$
            PState era
State (ledger era)
ps
              PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Map (KeyHash StakePool) StakePoolParams
 -> Identity (Map (KeyHash StakePool) StakePoolParams))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) StakePoolParams
 -> f (Map (KeyHash StakePool) StakePoolParams))
-> PState era -> f (PState era)
psFutureStakePoolParamsL
                ((Map (KeyHash StakePool) StakePoolParams
  -> Identity (Map (KeyHash StakePool) StakePoolParams))
 -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) StakePoolParams
    -> Map (KeyHash StakePool) StakePoolParams)
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyHash StakePool
-> StakePoolParams
-> Map (KeyHash StakePool) StakePoolParams
-> Map (KeyHash StakePool) StakePoolParams
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash StakePool
sppId StakePoolParams
stakePoolParams
              PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Map (KeyHash StakePool) EpochNo
 -> Identity (Map (KeyHash StakePool) EpochNo))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) EpochNo
 -> f (Map (KeyHash StakePool) EpochNo))
-> PState era -> f (PState era)
psRetiringL ((Map (KeyHash StakePool) EpochNo
  -> Identity (Map (KeyHash StakePool) EpochNo))
 -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) EpochNo
    -> Map (KeyHash StakePool) EpochNo)
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyHash StakePool
-> Map (KeyHash StakePool) EpochNo
-> Map (KeyHash StakePool) EpochNo
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete KeyHash StakePool
sppId
              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
%~ Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
-> Map (VRFVerKeyHash StakePoolVRF) (NonZero Word64)
updateFutureVRFKeyHash
    RetirePool KeyHash StakePool
sppId EpochNo
e -> do
      KeyHash StakePool -> Map (KeyHash StakePool) StakePoolState -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.member KeyHash StakePool
sppId Map (KeyHash StakePool) StakePoolState
psStakePools Bool
-> PredicateFailure (ledger era)
-> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! KeyHash StakePool -> ShelleyPoolPredFailure era
forall era. KeyHash StakePool -> ShelleyPoolPredFailure era
StakePoolNotRegisteredOnKeyPOOL KeyHash StakePool
sppId
      let maxEpoch :: EpochInterval
maxEpoch = PParams era
pp PParams era
-> Getting EpochInterval (PParams era) EpochInterval
-> EpochInterval
forall s a. s -> Getting a s a -> a
^. Getting EpochInterval (PParams era) EpochInterval
forall era. EraPParams era => Lens' (PParams era) EpochInterval
Lens' (PParams era) EpochInterval
ppEMaxL
          limitEpoch :: EpochNo
limitEpoch = EpochNo -> EpochInterval -> EpochNo
addEpochInterval EpochNo
cEpoch EpochInterval
maxEpoch
      (EpochNo
cEpoch EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
< EpochNo
e Bool -> Bool -> Bool
&& EpochNo
e EpochNo -> EpochNo -> Bool
forall a. Ord a => a -> a -> Bool
<= EpochNo
limitEpoch)
        Bool
-> PredicateFailure (ledger era)
-> F (Clause (ledger era) 'Transition) ()
forall sts (ctx :: RuleType).
Bool -> PredicateFailure sts -> Rule sts ctx ()
?! Mismatch RelGT EpochNo
-> Mismatch RelLTEQ EpochNo -> ShelleyPoolPredFailure era
forall era.
Mismatch RelGT EpochNo
-> Mismatch RelLTEQ EpochNo -> ShelleyPoolPredFailure era
StakePoolRetirementWrongEpochPOOL
          Mismatch -- RelGT - The supplied value should be greater than the current epoch
            { mismatchSupplied :: EpochNo
mismatchSupplied = EpochNo
e
            , mismatchExpected :: EpochNo
mismatchExpected = EpochNo
cEpoch
            }
          Mismatch -- RelLTEQ - The supplied value should be less then or equal to ppEMax after the current epoch
            { mismatchSupplied :: EpochNo
mismatchSupplied = EpochNo
e
            , mismatchExpected :: EpochNo
mismatchExpected = EpochNo
limitEpoch
            }
      -- We just schedule it for retirement. When it is retired we refund the deposit (see POOLREAP)
      PState era -> F (Clause (ledger era) 'Transition) (PState era)
forall a. a -> F (Clause (ledger era) 'Transition) a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (PState era -> F (Clause (ledger era) 'Transition) (PState era))
-> PState era -> F (Clause (ledger era) 'Transition) (PState era)
forall a b. (a -> b) -> a -> b
$ PState era
State (ledger era)
ps PState era -> (PState era -> PState era) -> PState era
forall a b. a -> (a -> b) -> b
& (Map (KeyHash StakePool) EpochNo
 -> Identity (Map (KeyHash StakePool) EpochNo))
-> PState era -> Identity (PState era)
forall era (f :: * -> *).
Functor f =>
(Map (KeyHash StakePool) EpochNo
 -> f (Map (KeyHash StakePool) EpochNo))
-> PState era -> f (PState era)
psRetiringL ((Map (KeyHash StakePool) EpochNo
  -> Identity (Map (KeyHash StakePool) EpochNo))
 -> PState era -> Identity (PState era))
-> (Map (KeyHash StakePool) EpochNo
    -> Map (KeyHash StakePool) EpochNo)
-> PState era
-> PState era
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ KeyHash StakePool
-> EpochNo
-> Map (KeyHash StakePool) EpochNo
-> Map (KeyHash StakePool) EpochNo
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert KeyHash StakePool
sppId EpochNo
e