{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE EmptyDataDeriving #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Cardano.Ledger.Shelley.Rules.PoolReap (
ShelleyPOOLREAP,
ShelleyPoolreapEvent (..),
ShelleyPoolreapState (..),
ShelleyPoolreapEnv (..),
PredicateFailure,
ShelleyPoolreapPredFailure,
prAcnt,
)
where
import Cardano.Ledger.Address (RewardAccount, raCredential)
import Cardano.Ledger.BaseTypes (ShelleyBase)
import Cardano.Ledger.CertState (VState)
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Keys (KeyHash, KeyRole (StakePool, Staking))
import Cardano.Ledger.PoolParams (ppRewardAccount)
import Cardano.Ledger.Shelley.Era (ShelleyEra, ShelleyPOOLREAP)
import Cardano.Ledger.Shelley.Governance (EraGov)
import Cardano.Ledger.Shelley.LedgerState (
AccountState (..),
CertState (..),
DState (..),
PState (..),
UTxOState (..),
allObligations,
rewards,
utxosGovStateL,
)
import Cardano.Ledger.Shelley.LedgerState.Types (potEqualsObligation)
import Cardano.Ledger.Slot (EpochNo (..))
import Cardano.Ledger.UMap (UView (RewDepUView, SPoolUView), compactCoinOrError)
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.Val ((<+>), (<->))
import Control.DeepSeq (NFData)
import Control.SetAlgebra (dom, eval, setSingleton, (⋪), (▷), (◁))
import Control.State.Transition (
Assertion (..),
AssertionViolation (..),
STS (..),
TRC (..),
TransitionRule,
judgmentContext,
tellEvent,
)
import Data.Default.Class (Default, def)
import Data.Foldable (fold)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import qualified Data.Set as Set (member)
import GHC.Generics (Generic)
import Lens.Micro
import NoThunks.Class (NoThunks (..))
data ShelleyPoolreapState era = PoolreapState
{ forall era. ShelleyPoolreapState era -> UTxOState era
prUTxOSt :: UTxOState era
, forall era. ShelleyPoolreapState era -> AccountState
prAccountState :: AccountState
, forall era. ShelleyPoolreapState era -> DState era
prDState :: DState era
, forall era. ShelleyPoolreapState era -> PState era
prPState :: PState era
}
prAcnt :: ShelleyPoolreapState era -> AccountState
prAcnt :: forall era. ShelleyPoolreapState era -> AccountState
prAcnt = forall era. ShelleyPoolreapState era -> AccountState
prAccountState
{-# DEPRECATED prAcnt "Use `prAccountState` instead" #-}
newtype ShelleyPoolreapEnv era = ShelleyPoolreapEnv
{ forall era. ShelleyPoolreapEnv era -> VState era
speVState :: VState era
}
deriving stock instance Eq (PParams era) => Eq (ShelleyPoolreapEnv era)
deriving stock instance Show (PParams era) => Show (ShelleyPoolreapEnv era)
deriving stock instance Show (UTxOState era) => Show (ShelleyPoolreapState era)
data ShelleyPoolreapPredFailure era
deriving (Int -> ShelleyPoolreapPredFailure era -> ShowS
forall era. Int -> ShelleyPoolreapPredFailure era -> ShowS
forall era. [ShelleyPoolreapPredFailure era] -> ShowS
forall era. ShelleyPoolreapPredFailure era -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ShelleyPoolreapPredFailure era] -> ShowS
$cshowList :: forall era. [ShelleyPoolreapPredFailure era] -> ShowS
show :: ShelleyPoolreapPredFailure era -> String
$cshow :: forall era. ShelleyPoolreapPredFailure era -> String
showsPrec :: Int -> ShelleyPoolreapPredFailure era -> ShowS
$cshowsPrec :: forall era. Int -> ShelleyPoolreapPredFailure era -> ShowS
Show, ShelleyPoolreapPredFailure era
-> ShelleyPoolreapPredFailure era -> Bool
forall era.
ShelleyPoolreapPredFailure era
-> ShelleyPoolreapPredFailure era -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ShelleyPoolreapPredFailure era
-> ShelleyPoolreapPredFailure era -> Bool
$c/= :: forall era.
ShelleyPoolreapPredFailure era
-> ShelleyPoolreapPredFailure era -> Bool
== :: ShelleyPoolreapPredFailure era
-> ShelleyPoolreapPredFailure era -> Bool
$c== :: forall era.
ShelleyPoolreapPredFailure era
-> ShelleyPoolreapPredFailure era -> Bool
Eq, forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyPoolreapPredFailure era) x
-> ShelleyPoolreapPredFailure era
forall era x.
ShelleyPoolreapPredFailure era
-> Rep (ShelleyPoolreapPredFailure era) x
$cto :: forall era x.
Rep (ShelleyPoolreapPredFailure era) x
-> ShelleyPoolreapPredFailure era
$cfrom :: forall era x.
ShelleyPoolreapPredFailure era
-> Rep (ShelleyPoolreapPredFailure era) x
Generic)
instance NFData (ShelleyPoolreapPredFailure era)
data ShelleyPoolreapEvent era = RetiredPools
{ forall era.
ShelleyPoolreapEvent era
-> Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
refundPools ::
Map.Map (Credential 'Staking (EraCrypto era)) (Map.Map (KeyHash 'StakePool (EraCrypto era)) Coin)
, forall era.
ShelleyPoolreapEvent era
-> Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
unclaimedPools ::
Map.Map (Credential 'Staking (EraCrypto era)) (Map.Map (KeyHash 'StakePool (EraCrypto era)) Coin)
, forall era. ShelleyPoolreapEvent era -> EpochNo
epochNo :: EpochNo
}
deriving (forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall era x.
Rep (ShelleyPoolreapEvent era) x -> ShelleyPoolreapEvent era
forall era x.
ShelleyPoolreapEvent era -> Rep (ShelleyPoolreapEvent era) x
$cto :: forall era x.
Rep (ShelleyPoolreapEvent era) x -> ShelleyPoolreapEvent era
$cfrom :: forall era x.
ShelleyPoolreapEvent era -> Rep (ShelleyPoolreapEvent era) x
Generic)
deriving instance Eq (ShelleyPoolreapEvent era)
instance NFData (ShelleyPoolreapEvent era)
instance NoThunks (ShelleyPoolreapPredFailure era)
instance Default (UTxOState era) => Default (ShelleyPoolreapState era) where
def :: ShelleyPoolreapState era
def = forall era.
UTxOState era
-> AccountState
-> DState era
-> PState era
-> ShelleyPoolreapState era
PoolreapState forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def forall a. Default a => a
def
type instance EraRuleEvent "POOLREAP" (ShelleyEra c) = ShelleyPoolreapEvent (ShelleyEra c)
instance
( Default (ShelleyPoolreapState era)
, EraPParams era
, EraGov era
) =>
STS (ShelleyPOOLREAP era)
where
type State (ShelleyPOOLREAP era) = ShelleyPoolreapState era
type Signal (ShelleyPOOLREAP era) = EpochNo
type Environment (ShelleyPOOLREAP era) = ShelleyPoolreapEnv era
type BaseM (ShelleyPOOLREAP era) = ShelleyBase
type PredicateFailure (ShelleyPOOLREAP era) = ShelleyPoolreapPredFailure era
type Event (ShelleyPOOLREAP era) = ShelleyPoolreapEvent era
transitionRules :: [TransitionRule (ShelleyPOOLREAP era)]
transitionRules = [forall era. TransitionRule (ShelleyPOOLREAP era)
poolReapTransition]
renderAssertionViolation :: AssertionViolation (ShelleyPOOLREAP era) -> String
renderAssertionViolation = forall era t.
(EraGov era, Environment t ~ ShelleyPoolreapEnv era,
State t ~ ShelleyPoolreapState era) =>
AssertionViolation t -> String
renderPoolReapViolation
assertions :: [Assertion (ShelleyPOOLREAP era)]
assertions =
[ forall sts.
String -> (TRC sts -> State sts -> Bool) -> Assertion sts
PostCondition
String
"Deposit pot must equal obligation (PoolReap)"
( \(TRC (Environment (ShelleyPOOLREAP era)
env, State (ShelleyPOOLREAP era)
_, Signal (ShelleyPOOLREAP era)
_)) State (ShelleyPOOLREAP era)
st ->
forall era. EraGov era => CertState era -> UTxOState era -> Bool
potEqualsObligation
(forall era. VState era -> PState era -> DState era -> CertState era
CertState (forall era. ShelleyPoolreapEnv era -> VState era
speVState Environment (ShelleyPOOLREAP era)
env) (forall era. ShelleyPoolreapState era -> PState era
prPState State (ShelleyPOOLREAP era)
st) (forall era. ShelleyPoolreapState era -> DState era
prDState State (ShelleyPOOLREAP era)
st))
(forall era. ShelleyPoolreapState era -> UTxOState era
prUTxOSt State (ShelleyPOOLREAP era)
st)
)
, forall sts.
String -> (TRC sts -> State sts -> Bool) -> Assertion sts
PostCondition
String
"PoolReap may not create or remove reward accounts"
( \(TRC (Environment (ShelleyPOOLREAP era)
_, State (ShelleyPOOLREAP era)
st, Signal (ShelleyPOOLREAP era)
_)) State (ShelleyPOOLREAP era)
st' ->
let r :: ShelleyPoolreapState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
r = forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era. ShelleyPoolreapState era -> DState era
prDState
in forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall {era}.
ShelleyPoolreapState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
r State (ShelleyPOOLREAP era)
st) forall a. Eq a => a -> a -> Bool
== forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall {era}.
ShelleyPoolreapState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
r State (ShelleyPOOLREAP era)
st')
)
]
poolReapTransition :: forall era. TransitionRule (ShelleyPOOLREAP era)
poolReapTransition :: forall era. TransitionRule (ShelleyPOOLREAP era)
poolReapTransition = do
TRC (Environment (ShelleyPOOLREAP era)
_, PoolreapState UTxOState era
us AccountState
a DState era
ds PState era
ps, Signal (ShelleyPOOLREAP era)
e) <- forall sts (rtype :: RuleType).
Rule sts rtype (RuleContext rtype sts)
judgmentContext
let
retired :: Set (KeyHash 'StakePool (EraCrypto era))
retired :: Set (KeyHash 'StakePool (EraCrypto era))
retired = forall s t. Embed s t => Exp t -> s
eval (forall k s (f :: * -> * -> *) v.
(Ord k, HasExp s (f k v)) =>
s -> Exp (Sett k ())
dom (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring PState era
ps forall k (g :: * -> * -> *) v s1 (f :: * -> * -> *) s2.
(Ord k, Iter g, Ord v, HasExp s1 (f k v), HasExp s2 (g v ())) =>
s1 -> s2 -> Exp (f k v)
▷ forall k. Ord k => k -> Exp (Single k ())
setSingleton Signal (ShelleyPOOLREAP era)
e))
retiringDeposits, remainingDeposits :: Map.Map (KeyHash 'StakePool (EraCrypto era)) Coin
(Map (KeyHash 'StakePool (EraCrypto era)) Coin
retiringDeposits, Map (KeyHash 'StakePool (EraCrypto era)) Coin
remainingDeposits) =
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\KeyHash 'StakePool (EraCrypto era)
k Coin
_ -> forall a. Ord a => a -> Set a -> Bool
Set.member KeyHash 'StakePool (EraCrypto era)
k Set (KeyHash 'StakePool (EraCrypto era))
retired) (forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits PState era
ps)
rewardAccounts :: Map.Map (KeyHash 'StakePool (EraCrypto era)) (RewardAccount (EraCrypto era))
rewardAccounts :: Map
(KeyHash 'StakePool (EraCrypto era))
(RewardAccount (EraCrypto era))
rewardAccounts = forall a b k. (a -> b) -> Map k a -> Map k b
Map.map forall c. PoolParams c -> RewardAccount c
ppRewardAccount forall a b. (a -> b) -> a -> b
$ forall s t. Embed s t => Exp t -> s
eval (Set (KeyHash 'StakePool (EraCrypto era))
retired forall k s1 s2 (f :: * -> * -> *) v.
(Ord k, HasExp s1 (Sett k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
◁ forall era.
PState era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
rewardAccounts_ ::
Map.Map (KeyHash 'StakePool (EraCrypto era)) (RewardAccount (EraCrypto era), Coin)
rewardAccounts_ :: Map
(KeyHash 'StakePool (EraCrypto era))
(RewardAccount (EraCrypto era), Coin)
rewardAccounts_ = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map
(KeyHash 'StakePool (EraCrypto era))
(RewardAccount (EraCrypto era))
rewardAccounts Map (KeyHash 'StakePool (EraCrypto era)) Coin
retiringDeposits
rewardAccounts' :: Map.Map (RewardAccount (EraCrypto era)) Coin
rewardAccounts' :: Map (RewardAccount (EraCrypto era)) Coin
rewardAccounts' =
forall k a. Ord k => (a -> a -> a) -> [(k, a)] -> Map k a
Map.fromListWith forall t. Val t => t -> t -> t
(<+>)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall k a. Map k a -> [a]
Map.elems
forall a b. (a -> b) -> a -> b
$ Map
(KeyHash 'StakePool (EraCrypto era))
(RewardAccount (EraCrypto era), Coin)
rewardAccounts_
refunds :: Map.Map (Credential 'Staking (EraCrypto era)) Coin
mRefunds :: Map.Map (Credential 'Staking (EraCrypto era)) Coin
(Map (Credential 'Staking (EraCrypto era)) Coin
refunds, Map (Credential 'Staking (EraCrypto era)) Coin
mRefunds) =
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey
(\Credential 'Staking (EraCrypto era)
k Coin
_ -> forall k c v. k -> UView c k v -> Bool
UM.member Credential 'Staking (EraCrypto era)
k (forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
ds))
(forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
Map.mapKeys forall c. RewardAccount c -> Credential 'Staking c
raCredential Map (RewardAccount (EraCrypto era)) Coin
rewardAccounts')
refunded :: Coin
refunded = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking (EraCrypto era)) Coin
refunds
unclaimed :: Coin
unclaimed = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map (Credential 'Staking (EraCrypto era)) Coin
mRefunds
forall sts (ctx :: RuleType). Event sts -> Rule sts ctx ()
tellEvent forall a b. (a -> b) -> a -> b
$
let rewardAccountsWithPool :: Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
rewardAccountsWithPool =
forall a k b. (a -> k -> b -> a) -> a -> Map k b -> a
Map.foldlWithKey'
( \Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
acc KeyHash 'StakePool (EraCrypto era)
sp (RewardAccount (EraCrypto era)
ra, Coin
coin) ->
forall k a. Ord k => (a -> a -> a) -> k -> a -> Map k a -> Map k a
Map.insertWith (forall k a. Ord k => (a -> a -> a) -> Map k a -> Map k a -> Map k a
Map.unionWith forall a. Semigroup a => a -> a -> a
(<>)) (forall c. RewardAccount c -> Credential 'Staking c
raCredential RewardAccount (EraCrypto era)
ra) (forall k a. k -> a -> Map k a
Map.singleton KeyHash 'StakePool (EraCrypto era)
sp Coin
coin) Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
acc
)
forall k a. Map k a
Map.empty
Map
(KeyHash 'StakePool (EraCrypto era))
(RewardAccount (EraCrypto era), Coin)
rewardAccounts_
(Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
refundPools', Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
unclaimedPools') =
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey
(\Credential 'Staking (EraCrypto era)
k Map (KeyHash 'StakePool (EraCrypto era)) Coin
_ -> forall k c v. k -> UView c k v -> Bool
UM.member Credential 'Staking (EraCrypto era)
k (forall era.
DState era
-> UView
(EraCrypto era) (Credential 'Staking (EraCrypto era)) RDPair
rewards DState era
ds))
Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
rewardAccountsWithPool
in RetiredPools
{ refundPools :: Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
refundPools = Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
refundPools'
, unclaimedPools :: Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
unclaimedPools = Map
(Credential 'Staking (EraCrypto era))
(Map (KeyHash 'StakePool (EraCrypto era)) Coin)
unclaimedPools'
, epochNo :: EpochNo
epochNo = Signal (ShelleyPOOLREAP era)
e
}
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
forall era.
UTxOState era
-> AccountState
-> DState era
-> PState era
-> ShelleyPoolreapState era
PoolreapState
UTxOState era
us {utxosDeposited :: Coin
utxosDeposited = forall era. UTxOState era -> Coin
utxosDeposited UTxOState era
us forall t. Val t => t -> t -> t
<-> (Coin
unclaimed forall t. Val t => t -> t -> t
<+> Coin
refunded)}
AccountState
a {asTreasury :: Coin
asTreasury = AccountState -> Coin
asTreasury AccountState
a forall t. Val t => t -> t -> t
<+> Coin
unclaimed}
( let u0 :: UMap (EraCrypto era)
u0 = forall era. DState era -> UMap (EraCrypto era)
dsUnified DState era
ds
u1 :: UMap (EraCrypto era)
u1 = forall c. UMap c -> UView c (Credential 'Staking c) RDPair
RewDepUView UMap (EraCrypto era)
u0 forall c.
UView c (Credential 'Staking c) RDPair
-> Map (Credential 'Staking c) (CompactForm Coin) -> UMap c
UM.∪+ forall a b k. (a -> b) -> Map k a -> Map k b
Map.map HasCallStack => Coin -> CompactForm Coin
compactCoinOrError Map (Credential 'Staking (EraCrypto era)) Coin
refunds
u2 :: UMap (EraCrypto era)
u2 = forall c.
UMap c -> UView c (Credential 'Staking c) (KeyHash 'StakePool c)
SPoolUView UMap (EraCrypto era)
u1 forall c k v. UView c k v -> Set v -> UMap c
UM.⋫ Set (KeyHash 'StakePool (EraCrypto era))
retired
in DState era
ds {dsUnified :: UMap (EraCrypto era)
dsUnified = UMap (EraCrypto era)
u2}
)
PState era
ps
{ psStakePoolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams = forall s t. Embed s t => Exp t -> s
eval (Set (KeyHash 'StakePool (EraCrypto era))
retired forall k (g :: * -> * -> *) s1 s2 (f :: * -> * -> *) v.
(Ord k, Iter g, HasExp s1 (g k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
⋪ forall era.
PState era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psStakePoolParams PState era
ps)
,
psFutureStakePoolParams :: Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psFutureStakePoolParams = forall s t. Embed s t => Exp t -> s
eval (Set (KeyHash 'StakePool (EraCrypto era))
retired forall k (g :: * -> * -> *) s1 s2 (f :: * -> * -> *) v.
(Ord k, Iter g, HasExp s1 (g k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
⋪ forall era.
PState era
-> Map
(KeyHash 'StakePool (EraCrypto era)) (PoolParams (EraCrypto era))
psFutureStakePoolParams PState era
ps)
, psRetiring :: Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring = forall s t. Embed s t => Exp t -> s
eval (Set (KeyHash 'StakePool (EraCrypto era))
retired forall k (g :: * -> * -> *) s1 s2 (f :: * -> * -> *) v.
(Ord k, Iter g, HasExp s1 (g k ()), HasExp s2 (f k v)) =>
s1 -> s2 -> Exp (f k v)
⋪ forall era.
PState era -> Map (KeyHash 'StakePool (EraCrypto era)) EpochNo
psRetiring PState era
ps)
, psDeposits :: Map (KeyHash 'StakePool (EraCrypto era)) Coin
psDeposits = Map (KeyHash 'StakePool (EraCrypto era)) Coin
remainingDeposits
}
renderPoolReapViolation ::
( EraGov era
, Environment t ~ ShelleyPoolreapEnv era
, State t ~ ShelleyPoolreapState era
) =>
AssertionViolation t ->
String
renderPoolReapViolation :: forall era t.
(EraGov era, Environment t ~ ShelleyPoolreapEnv era,
State t ~ ShelleyPoolreapState era) =>
AssertionViolation t -> String
renderPoolReapViolation
AssertionViolation {String
avSTS :: forall sts. AssertionViolation sts -> String
avSTS :: String
avSTS, String
avMsg :: forall sts. AssertionViolation sts -> String
avMsg :: String
avMsg, avCtx :: forall sts. AssertionViolation sts -> TRC sts
avCtx = TRC (ShelleyPoolreapEnv VState era
vs, State t
poolreapst, Signal t
_)} =
let certst :: CertState era
certst = forall era. VState era -> PState era -> DState era -> CertState era
CertState VState era
vs (forall era. ShelleyPoolreapState era -> PState era
prPState State t
poolreapst) (forall era. ShelleyPoolreapState era -> DState era
prDState State t
poolreapst)
obligations :: Obligations
obligations = forall era.
EraGov era =>
CertState era -> GovState era -> Obligations
allObligations CertState era
certst (forall era. ShelleyPoolreapState era -> UTxOState era
prUTxOSt State t
poolreapst forall s a. s -> Getting a s a -> a
^. forall era. Lens' (UTxOState era) (GovState era)
utxosGovStateL)
in String
"\n\nAssertionViolation ("
forall a. Semigroup a => a -> a -> a
<> String
avSTS
forall a. Semigroup a => a -> a -> a
<> String
")\n "
forall a. Semigroup a => a -> a -> a
<> String
avMsg
forall a. Semigroup a => a -> a -> a
<> String
"\npot (utxosDeposited) = "
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show (forall era. UTxOState era -> Coin
utxosDeposited (forall era. ShelleyPoolreapState era -> UTxOState era
prUTxOSt State t
poolreapst))
forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Obligations
obligations