{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Cardano.Ledger.Shelley.LedgerState.NewEpochState (
availableAfterMIR,
getGKeys,
genesisState,
updateNES,
returnRedeemAddrsToReserves,
) where
import Cardano.Ledger.Address (isBootstrapRedeemer)
import Cardano.Ledger.BaseTypes (
BlocksMade (..),
)
import Cardano.Ledger.CertState (
CertState (..),
DState (..),
InstantaneousRewards (..),
)
import Cardano.Ledger.Coin (Coin (..), addDeltaCoin)
import Cardano.Ledger.Keys (
GenDelegPair (..),
GenDelegs (..),
KeyHash (..),
KeyRole (..),
)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState.Types
import qualified Cardano.Ledger.UMap as UM
import Cardano.Ledger.UTxO (UTxO (..), coinBalance)
import Cardano.Ledger.Val ((<+>), (<->))
import Data.Default.Class (def)
import Data.Foldable (fold)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Set (Set)
import Lens.Micro ((&), (.~), (^.))
import Lens.Micro.Extras (view)
availableAfterMIR :: MIRPot -> AccountState -> InstantaneousRewards c -> Coin
availableAfterMIR :: forall c. MIRPot -> AccountState -> InstantaneousRewards c -> Coin
availableAfterMIR MIRPot
ReservesMIR AccountState
as InstantaneousRewards c
ir =
AccountState -> Coin
asReserves AccountState
as Coin -> DeltaCoin -> Coin
`addDeltaCoin` forall c. InstantaneousRewards c -> DeltaCoin
deltaReserves InstantaneousRewards c
ir forall t. Val t => t -> t -> t
<-> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
iRReserves InstantaneousRewards c
ir)
availableAfterMIR MIRPot
TreasuryMIR AccountState
as InstantaneousRewards c
ir =
AccountState -> Coin
asTreasury AccountState
as Coin -> DeltaCoin -> Coin
`addDeltaCoin` forall c. InstantaneousRewards c -> DeltaCoin
deltaTreasury InstantaneousRewards c
ir forall t. Val t => t -> t -> t
<-> forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold (forall c.
InstantaneousRewards c -> Map (Credential 'Staking c) Coin
iRTreasury InstantaneousRewards c
ir)
getGKeys ::
NewEpochState era ->
Set (KeyHash 'Genesis (EraCrypto era))
getGKeys :: forall era.
NewEpochState era -> Set (KeyHash 'Genesis (EraCrypto era))
getGKeys NewEpochState era
nes = forall k a. Map k a -> Set k
Map.keysSet Map
(KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs
where
NewEpochState EpochNo
_ BlocksMade (EraCrypto era)
_ BlocksMade (EraCrypto era)
_ EpochState era
es StrictMaybe (PulsingRewUpdate (EraCrypto era))
_ PoolDistr (EraCrypto era)
_ StashedAVVMAddresses era
_ = NewEpochState era
nes
EpochState AccountState
_ LedgerState era
ls SnapShots (EraCrypto era)
_ NonMyopic (EraCrypto era)
_ = EpochState era
es
LedgerState UTxOState era
_ (CertState VState era
_ PState era
_ DState {dsGenDelegs :: forall era. DState era -> GenDelegs (EraCrypto era)
dsGenDelegs = (GenDelegs Map
(KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs)}) = LedgerState era
ls
genesisState ::
forall era.
EraGov era =>
Map (KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era)) ->
UTxO era ->
LedgerState era
genesisState :: forall era.
EraGov era =>
Map
(KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
-> UTxO era -> LedgerState era
genesisState Map
(KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs0 UTxO era
utxo0 =
forall era. UTxOState era -> CertState era -> LedgerState era
LedgerState
( forall era.
UTxO era
-> Coin
-> Coin
-> GovState era
-> IncrementalStake (EraCrypto era)
-> Coin
-> UTxOState era
UTxOState
UTxO era
utxo0
(Integer -> Coin
Coin Integer
0)
(Integer -> Coin
Coin Integer
0)
forall era. EraGov era => GovState era
emptyGovState
(forall c.
Map (Credential 'Staking c) (CompactForm Coin)
-> Map Ptr (CompactForm Coin) -> IncrementalStake c
IStake forall a. Monoid a => a
mempty forall k a. Map k a
Map.empty)
forall a. Monoid a => a
mempty
)
(forall era. VState era -> PState era -> DState era -> CertState era
CertState forall a. Default a => a
def forall a. Default a => a
def DState era
dState)
where
dState :: DState era
dState :: DState era
dState =
DState
{ dsUnified :: UMap (EraCrypto era)
dsUnified = forall c. UMap c
UM.empty
, dsFutureGenDelegs :: Map (FutureGenDeleg (EraCrypto era)) (GenDelegPair (EraCrypto era))
dsFutureGenDelegs = forall k a. Map k a
Map.empty
, dsGenDelegs :: GenDelegs (EraCrypto era)
dsGenDelegs = forall c. Map (KeyHash 'Genesis c) (GenDelegPair c) -> GenDelegs c
GenDelegs Map
(KeyHash 'Genesis (EraCrypto era)) (GenDelegPair (EraCrypto era))
genDelegs0 :: GenDelegs (EraCrypto era)
, dsIRewards :: InstantaneousRewards (EraCrypto era)
dsIRewards = forall a. Default a => a
def
}
updateNES ::
EraGov era =>
NewEpochState era ->
BlocksMade (EraCrypto era) ->
LedgerState era ->
NewEpochState era
updateNES :: forall era.
EraGov era =>
NewEpochState era
-> BlocksMade (EraCrypto era)
-> LedgerState era
-> NewEpochState era
updateNES
oldNes :: NewEpochState era
oldNes@( NewEpochState
EpochNo
_eL
BlocksMade (EraCrypto era)
_bprev
BlocksMade (EraCrypto era)
_
es :: EpochState era
es@(EpochState AccountState
acnt LedgerState era
_ SnapShots (EraCrypto era)
ss NonMyopic (EraCrypto era)
nm)
StrictMaybe (PulsingRewUpdate (EraCrypto era))
_ru
PoolDistr (EraCrypto era)
_pd
StashedAVVMAddresses era
_avvm
)
BlocksMade (EraCrypto era)
bcur
LedgerState era
ls =
let
pp :: PParams era
pp = EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL
pr :: PParams era
pr = EpochState era
es forall s a. s -> Getting a s a -> a
^. forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL
in
NewEpochState era
oldNes
{ nesBcur :: BlocksMade (EraCrypto era)
nesBcur = BlocksMade (EraCrypto era)
bcur
, nesEs :: EpochState era
nesEs =
forall era.
AccountState
-> LedgerState era
-> SnapShots (EraCrypto era)
-> NonMyopic (EraCrypto era)
-> EpochState era
EpochState AccountState
acnt LedgerState era
ls SnapShots (EraCrypto era)
ss NonMyopic (EraCrypto era)
nm
forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
curPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pp
forall a b. a -> (a -> b) -> b
& forall era. EraGov era => Lens' (EpochState era) (PParams era)
prevPParamsEpochStateL forall s t a b. ASetter s t a b -> b -> s -> t
.~ PParams era
pr
}
returnRedeemAddrsToReserves ::
forall era.
EraTxOut era =>
EpochState era ->
EpochState era
returnRedeemAddrsToReserves :: forall era. EraTxOut era => EpochState era -> EpochState era
returnRedeemAddrsToReserves EpochState era
es = EpochState era
es {esAccountState :: AccountState
esAccountState = AccountState
acnt', esLState :: LedgerState era
esLState = LedgerState era
ls'}
where
ls :: LedgerState era
ls = forall era. EpochState era -> LedgerState era
esLState EpochState era
es
us :: UTxOState era
us = forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
utxo = forall era. UTxOState era -> UTxO era
utxosUtxo UTxOState era
us
(Map (TxIn (EraCrypto era)) (TxOut era)
redeemers, Map (TxIn (EraCrypto era)) (TxOut era)
nonredeemers) =
forall a k. (a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partition (forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False forall c. BootstrapAddress c -> Bool
isBootstrapRedeemer forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting a s a -> s -> a
view forall era.
EraTxOut era =>
SimpleGetter (TxOut era) (Maybe (BootstrapAddress (EraCrypto era)))
bootAddrTxOutF) Map (TxIn (EraCrypto era)) (TxOut era)
utxo
acnt :: AccountState
acnt = forall era. EpochState era -> AccountState
esAccountState EpochState era
es
utxoR :: UTxO era
utxoR = forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
redeemers :: UTxO era
acnt' :: AccountState
acnt' =
AccountState
acnt
{ asReserves :: Coin
asReserves = AccountState -> Coin
asReserves AccountState
acnt forall t. Val t => t -> t -> t
<+> forall era. EraTxOut era => UTxO era -> Coin
coinBalance UTxO era
utxoR
}
us' :: UTxOState era
us' = UTxOState era
us {utxosUtxo :: UTxO era
utxosUtxo = forall era. Map (TxIn (EraCrypto era)) (TxOut era) -> UTxO era
UTxO Map (TxIn (EraCrypto era)) (TxOut era)
nonredeemers :: UTxO era}
ls' :: LedgerState era
ls' = LedgerState era
ls {lsUTxOState :: UTxOState era
lsUTxOState = UTxOState era
us'}