diff --git a/cardano-api/cardano-api.cabal b/cardano-api/cardano-api.cabal index dbfbc638d0..626fabc7e6 100644 --- a/cardano-api/cardano-api.cabal +++ b/cardano-api/cardano-api.cabal @@ -107,8 +107,11 @@ library internal Cardano.Api.Ledger.Lens Cardano.Api.LedgerState Cardano.Api.LedgerEvents.LedgerEvent + Cardano.Api.LedgerEvents.Rule.DELEGS + Cardano.Api.LedgerEvents.Rule.LEDGER Cardano.Api.LedgerEvents.Rule.NEWEPOCH Cardano.Api.LedgerEvents.Rule.RUPD + Cardano.Api.LedgerEvents.Rule.UTXOW Cardano.Api.LedgerEvents.Rule.Types Cardano.Api.Modes Cardano.Api.NetworkId diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs index 0743074cbe..40fb2e0971 100644 --- a/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/LedgerEvent.hs @@ -2,7 +2,6 @@ {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE GADTs #-} -{-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE PartialTypeSignatures #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE TypeOperators #-} @@ -23,10 +22,13 @@ where import Cardano.Api.Address (StakeCredential, fromShelleyStakeCredential) import Cardano.Api.Block (EpochNo) -import Cardano.Api.Keys.Shelley (Hash (StakePoolKeyHash), StakePoolKey) -import Cardano.Api.LedgerEvents.Rule.NEWEPOCH (handleShelleyNEWEPOCHEvents) -import Cardano.Api.LedgerEvents.Rule.RUPD (handleShelleyLedgerRUPDEvents) +import Cardano.Api.Keys.Shelley (Hash (..), StakePoolKey) +import Cardano.Api.LedgerEvents.Rule.LEDGER (handleShelleyLEDGEREvents) +import Cardano.Api.LedgerEvents.Rule.NEWEPOCH (handleConwayNEWEPOCHEvents, + handleShelleyNEWEPOCHEvents) +import Cardano.Api.LedgerEvents.Rule.RUPD (handleLedgerRUPDEvents) import Cardano.Api.LedgerEvents.Rule.Types +import Cardano.Api.LedgerEvents.Rule.UTXOW import Cardano.Api.Value (Lovelace, fromShelleyDeltaLovelace, fromShelleyLovelace) import Cardano.Ledger.Alonzo.Plutus.TxInfo (PlutusDebug) @@ -84,16 +86,10 @@ instance ConvertLedgerEvent (ShelleyBlock protocol (AllegraEra StandardCrypto)) toLedgerEvent = toLedgerEventShelley instance ConvertLedgerEvent (ShelleyBlock protocol (AlonzoEra StandardCrypto)) where - toLedgerEvent evt = case unwrapLedgerEvent evt of - LEPlutusSuccess ds -> Just $ SuccessfulPlutusScript ds - LEPlutusFailure ds -> Just $ FailedPlutusScript ds - _ -> toLedgerEventShelley evt + toLedgerEvent evt = handleAlonzoToBabbageLedgerEvents $ unwrapLedgerEvent evt instance ConvertLedgerEvent (ShelleyBlock protocol (BabbageEra StandardCrypto)) where - toLedgerEvent evt = case unwrapLedgerEvent evt of - LEPlutusSuccess ds -> Just $ SuccessfulPlutusScript ds - LEPlutusFailure ds -> Just $ FailedPlutusScript ds - _ -> toLedgerEventShelley evt + toLedgerEvent evt = handleAlonzoToBabbageLedgerEvents $ unwrapLedgerEvent evt instance ConvertLedgerEvent (ShelleyBlock protocol (ConwayEra StandardCrypto)) where toLedgerEvent = toLedgerEventConway @@ -147,26 +143,32 @@ pattern ConwayLedgerEvent -> NS WrapLedgerEvent (Consensus.CardanoEras StandardCrypto) pattern ConwayLedgerEvent x = S (S (S (S (S (S (Z x)))))) -toLedgerEventShelley :: - ( EraCrypto ledgerera ~ StandardCrypto, - Event (Ledger.Core.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera, - Event (Ledger.Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera, - Event (Ledger.Core.EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera, - Event (Ledger.Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera, - Event (Ledger.Core.EraRule "MIR" ledgerera) ~ ShelleyMirEvent ledgerera, - Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto - ) => - WrapLedgerEvent (ShelleyBlock protocol ledgerera) -> +toLedgerEventShelley + :: Event (Ledger.Core.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera + => Event (Ledger.Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera + -- Event (Ledger.Core.EraRule "EPOCH" ledgerera) ~ ShelleyEpochEvent ledgerera, + -- Event (Ledger.Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera, + -- Event (Ledger.Core.EraRule "MIR" ledgerera) ~ ShelleyMirEvent ledgerera, + => Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto + => Event (Ledger.Core.EraRule "BBODY" ledgerera) ~ ShelleyBbodyEvent ledgerera + => Event (Ledger.Core.EraRule "LEDGERS" ledgerera) ~ Shelley.ShelleyLedgersEvent ledgerera + => Event (Ledger.Core.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera + => Event (Ledger.Core.EraRule "UTXOW" ledgerera) ~ ShelleyUtxowEvent ledgerera + => WrapLedgerEvent (ShelleyBlock protocol ledgerera) -> Maybe LedgerEvent toLedgerEventShelley evt = case unwrapLedgerEvent evt of - LEDeltaRewardEvent e m -> Just $ IncrementalRewardsDistribution e m - LERewardEvent e m -> Just $ RewardsDistribution e m - LEMirTransfer rp rt rtt ttr -> - Just $ - MIRDistribution $ - MIRDistributionDetails rp rt rtt ttr - LERetiredPools r u e -> Just $ PoolReap $ PoolReapDetails e r u - _ -> Nothing + ShelleyLedgerEventTICK e -> handleShelleyLedgerTICKEvents e + ShelleyLedgerEventBBODY e -> handlePreAlonzoLedgerBBODYEvents e + +handlePreAlonzoLedgerBBODYEvents + :: Event (Ledger.Core.EraRule "LEDGERS" ledgerera) ~ Shelley.ShelleyLedgersEvent ledgerera + => Event (Ledger.Core.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera + => Event (Ledger.Core.EraRule "UTXOW" ledgerera) ~ ShelleyUtxowEvent ledgerera + => ShelleyBbodyEvent ledgerera -> Maybe LedgerEvent +handlePreAlonzoLedgerBBODYEvents (LedgersEvent (Shelley.LedgerEvent e)) = + case e of + Shelley.UtxowEvent ev -> handlePreAlonzoUTxOWEvent ev + Shelley.DelegsEvent{} -> Nothing -- TODO: Extract era specific events to their own modules and use the COMPLETE paramsAllegra toLedgerEventConway @@ -174,15 +176,6 @@ toLedgerEventConway -> Maybe LedgerEvent toLedgerEventConway evt = handleAllConwayEvents $ unwrapLedgerEvent evt --- case unwrapLedgerEvent evt of --- -- TODO: Return all existing ledger events --- LEGovNewProposals txid proposals -> --- Just $ NewGovernanceProposals txid (AnyProposals proposals) --- LEEpochBoundaryRatificationState ratState -> --- Just $ EpochBoundaryRatificationState (AnyRatificationState ratState) --- _ -> Nothing - - -------------------------------------------------------------------------------- -- Patterns for event access -------------------------------------------------------------------------------- @@ -264,7 +257,8 @@ pattern LERetiredPools r u e <- ) ) ) -handlePreConwayLedgerEvents + +handleAlonzoToBabbageLedgerEvents :: Event (Ledger.Core.EraRule "TICK" ledgerera) ~ ShelleyTickEvent ledgerera => Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto => Event (Ledger.Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera @@ -277,19 +271,19 @@ handlePreConwayLedgerEvents => Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera => Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera => AuxLedgerEvent (LedgerState (ShelleyBlock protocol ledgerera)) -> Maybe LedgerEvent -handlePreConwayLedgerEvents (ShelleyLedgerEventTICK tickEvent) = +handleAlonzoToBabbageLedgerEvents (ShelleyLedgerEventTICK tickEvent) = handleShelleyLedgerTICKEvents tickEvent -handlePreConwayLedgerEvents (ShelleyLedgerEventBBODY bbodyEvent) = - handleShelleyLedgerBBODYEvents bbodyEvent +handleAlonzoToBabbageLedgerEvents (ShelleyLedgerEventBBODY bbodyEvent) = + handleAlonzoToConwayLedgerBBODYEvents bbodyEvent handleShelleyLedgerTICKEvents :: Event (Ledger.Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto => Event (Ledger.Core.EraRule "NEWEPOCH" ledgerera) ~ ShelleyNewEpochEvent ledgerera => ShelleyTickEvent ledgerera -> Maybe LedgerEvent handleShelleyLedgerTICKEvents (TickNewEpochEvent newEpochEvent) = handleShelleyNEWEPOCHEvents newEpochEvent -handleShelleyLedgerTICKEvents (TickRupdEvent rewardUpdate) = handleShelleyLedgerRUPDEvents rewardUpdate +handleShelleyLedgerTICKEvents (TickRupdEvent rewardUpdate) = handleLedgerRUPDEvents rewardUpdate -handleShelleyLedgerBBODYEvents +handleAlonzoToConwayLedgerBBODYEvents :: Event (Ledger.Core.EraRule "LEDGERS" ledgerera) ~ Shelley.ShelleyLedgersEvent ledgerera => Event (Ledger.Core.EraRule "LEDGER" ledgerera) ~ Shelley.ShelleyLedgerEvent ledgerera => Event (Ledger.Core.EraRule "UTXO" ledgerera)~ AlonzoUtxoEvent ledgerera @@ -297,53 +291,21 @@ handleShelleyLedgerBBODYEvents => Event (Ledger.Core.EraRule "UTXOW" ledgerera) ~ AlonzoUtxowEvent ledgerera => Event (Ledger.Core.EraRule "DELEGS" ledgerera) ~ Shelley.ShelleyDelegsEvent ledgerera => AlonzoBbodyEvent ledgerera -> Maybe LedgerEvent -handleShelleyLedgerBBODYEvents (ShelleyInAlonzoEvent (LedgersEvent (Shelley.LedgerEvent ledgerEvent))) = - case ledgerEvent of - Shelley.UtxowEvent e -> handleShelleyUTxOWEvent e - Shelley.DelegsEvent e -> handleShelleyDELEGSEvent e +handleAlonzoToConwayLedgerBBODYEvents (ShelleyInAlonzoEvent (LedgersEvent (Shelley.LedgerEvent ledgerEvent))) = + handleShelleyLEDGEREvents ledgerEvent + -handleShelleyUTxOWEvent - :: Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera - => Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera - => AlonzoUtxowEvent ledgerera -> Maybe LedgerEvent -handleShelleyUTxOWEvent (WrappedShelleyEraEvent (UtxoEvent (UtxosEvent utxoEvent))) = - case utxoEvent of - Alonzo.AlonzoPpupToUtxosEvent{} -> Nothing - Alonzo.TotalDeposits{} -> Nothing - Alonzo.SuccessfulPlutusScriptsEvent{} -> Nothing - Alonzo.FailedPlutusScriptsEvent{} -> Nothing -handleShelleyDELEGSEvent :: Shelley.ShelleyDelegsEvent ledgerera -> Maybe LedgerEvent -handleShelleyDELEGSEvent _ = Nothing -- TODO: Instead of cumbersome pattern matches, use a function so ghc can -- tell us about new/unhandled events handleAllConwayEvents :: AuxLedgerEvent (LedgerState (ShelleyBlock protocol (ConwayEra StandardCrypto))) -> Maybe LedgerEvent -handleAllConwayEvents (ShelleyLedgerEventTICK (TickNewEpochEvent (Conway.DeltaRewardEvent rewardUpdate))) = - case rewardUpdate of - RupdEvent epochNum rewards -> - Just $ IncrementalRewardsDistribution epochNum (Map.mapKeys fromShelleyStakeCredential rewards) -handleAllConwayEvents (ShelleyLedgerEventTICK (TickNewEpochEvent (Conway.RestrainedRewards _ _ _))) = Nothing -handleAllConwayEvents (ShelleyLedgerEventTICK (TickNewEpochEvent (Conway.TotalRewardEvent epochNo rewardsMap))) = - Just $ RewardsDistribution epochNo (Map.mapKeys fromShelleyStakeCredential rewardsMap) -handleAllConwayEvents (ShelleyLedgerEventTICK (TickNewEpochEvent (Conway.EpochEvent epochEvent))) = - case epochEvent of - Conway.EpochBoundaryRatifyState ratifyState -> - Just $ EpochBoundaryRatificationState (AnyRatificationState ratifyState) - Conway.PoolReapEvent poolReap -> - case poolReap of - RetiredPools {refundPools, unclaimedPools, epochNo} -> - Just . PoolReap $ PoolReapDetails epochNo - (convertRetiredPoolsMap refundPools) - (convertRetiredPoolsMap unclaimedPools) - Conway.SnapEvent _ -> Nothing -handleAllConwayEvents (ShelleyLedgerEventTICK (TickNewEpochEvent (Conway.TotalAdaPotsEvent _))) = Nothing +handleAllConwayEvents (ShelleyLedgerEventTICK (TickNewEpochEvent newEpochEvent)) = + handleConwayNEWEPOCHEvents newEpochEvent handleAllConwayEvents (ShelleyLedgerEventTICK (TickRupdEvent rewardUpdate)) = - case rewardUpdate of - RupdEvent epochNum rewards -> - Just $ IncrementalRewardsDistribution epochNum (Map.mapKeys fromShelleyStakeCredential rewards) + handleLedgerRUPDEvents rewardUpdate handleAllConwayEvents (ShelleyLedgerEventBBODY (ShelleyInAlonzoEvent (LedgersEvent (Shelley.LedgerEvent conwayLedgerEvent)))) = case conwayLedgerEvent of @@ -415,9 +377,4 @@ pattern LEPlutusFailure ds <- ) ) -convertRetiredPoolsMap :: - Map (Ledger.StakeCredential StandardCrypto) (Map (Ledger.KeyHash Ledger.StakePool StandardCrypto) Ledger.Coin) - -> Map StakeCredential (Map (Hash StakePoolKey) Lovelace) -convertRetiredPoolsMap = - Map.mapKeys fromShelleyStakeCredential - . fmap (Map.mapKeys StakePoolKeyHash . fmap fromShelleyLovelace) + diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/DELEGS.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/DELEGS.hs new file mode 100644 index 0000000000..7aa811f389 --- /dev/null +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/DELEGS.hs @@ -0,0 +1,13 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.LedgerEvents.Rule.DELEGS + ( handleShelleyDELEGSEvent + ) where + +import Cardano.Api.LedgerEvents.Rule.Types + +import qualified Cardano.Ledger.Shelley.Rules as Shelley + +handleShelleyDELEGSEvent :: Shelley.ShelleyDelegsEvent ledgerera -> Maybe LedgerEvent +handleShelleyDELEGSEvent _ = Nothing diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/LEDGER.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/LEDGER.hs new file mode 100644 index 0000000000..a0b561c31f --- /dev/null +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/LEDGER.hs @@ -0,0 +1,29 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.LedgerEvents.Rule.LEDGER + ( handleShelleyLEDGEREvents + ) where + +import Cardano.Api.LedgerEvents.Rule.DELEGS +import Cardano.Api.LedgerEvents.Rule.Types +import Cardano.Api.LedgerEvents.Rule.UTXOW + +import Cardano.Ledger.Alonzo.Rules (AlonzoUtxoEvent (..), AlonzoUtxosEvent (..), + AlonzoUtxowEvent (..)) +import qualified Cardano.Ledger.Core as Ledger.Core +import qualified Cardano.Ledger.Shelley.Rules as Shelley + +import Control.State.Transition.Extended + + +handleShelleyLEDGEREvents + :: Event (Ledger.Core.EraRule "UTXOW" ledgerera) ~ AlonzoUtxowEvent ledgerera + => Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera + => Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera + => Event (Ledger.Core.EraRule "DELEGS" ledgerera) ~ Shelley.ShelleyDelegsEvent ledgerera + => Shelley.ShelleyLedgerEvent ledgerera -> Maybe LedgerEvent +handleShelleyLEDGEREvents ledgerEvent = + case ledgerEvent of + Shelley.UtxowEvent e -> handleAlonzoOnwardsUTxOWEvent e + Shelley.DelegsEvent e -> handleShelleyDELEGSEvent e diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/NEWEPOCH.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/NEWEPOCH.hs index 950aa451e4..2c0da8e504 100644 --- a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/NEWEPOCH.hs +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/NEWEPOCH.hs @@ -1,37 +1,24 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE NamedFieldPuns #-} +{-# LANGUAGE TypeFamilies #-} + module Cardano.Api.LedgerEvents.Rule.NEWEPOCH ( handleShelleyNEWEPOCHEvents + , handleConwayNEWEPOCHEvents ) where - -import Cardano.Ledger.Shelley.Rules -import Cardano.Api.LedgerEvents.Rule.Types -import Cardano.Api.Address (StakeCredential, fromShelleyStakeCredential) -import Cardano.Api.Block (EpochNo) -import Cardano.Api.Keys.Shelley (Hash (StakePoolKeyHash), StakePoolKey) -import Cardano.Api.Value (Lovelace, fromShelleyDeltaLovelace, fromShelleyLovelace) - -import Cardano.Ledger.Alonzo.Plutus.TxInfo (PlutusDebug) -import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyEvent (..), AlonzoUtxoEvent (..), - AlonzoUtxosEvent (FailedPlutusScriptsEvent, SuccessfulPlutusScriptsEvent), - AlonzoUtxowEvent (..)) -import qualified Cardano.Ledger.Alonzo.Rules as Alonzo -import Cardano.Ledger.Api.Era (AllegraEra, AlonzoEra, BabbageEra, ConwayEra, MaryEra, - ShelleyEra) -import qualified Cardano.Ledger.Coin as Ledger -import qualified Cardano.Ledger.Conway.Governance as Ledger + +import Cardano.Api.Address (fromShelleyStakeCredential) +import Cardano.Api.LedgerEvents.Rule.Types +import Cardano.Api.ReexposeLedger + +import Cardano.Ledger.Conway.Rules (ConwayNewEpochEvent) import qualified Cardano.Ledger.Conway.Rules as Conway -import Cardano.Ledger.Core (EraCrypto) -import qualified Cardano.Ledger.Core as Ledger.Core -import qualified Cardano.Ledger.Credential as Ledger -import Cardano.Ledger.Crypto (StandardCrypto) -import qualified Cardano.Ledger.Keys as Ledger -import Cardano.Ledger.Shelley.API (InstantaneousRewards (InstantaneousRewards)) -import Cardano.Ledger.Shelley.Rewards (Reward) +import qualified Cardano.Ledger.Core as Core +import Cardano.Ledger.Shelley.Rules + import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Cardano.Ledger.Shelley.Rules as Shelley -import qualified Cardano.Ledger.Shelley.Rules as Shelley (ShelleyLedgerEvent (UtxowEvent), - ShelleyLedgersEvent (LedgerEvent)) -import qualified Cardano.Ledger.TxIn as Ledger + + handleShelleyNEWEPOCHEvents :: ShelleyNewEpochEvent ledgerera -> Maybe LedgerEvent handleShelleyNEWEPOCHEvents shelleyNewEpochEvent = @@ -41,4 +28,36 @@ handleShelleyNEWEPOCHEvents shelleyNewEpochEvent = TotalRewardEvent{} -> Nothing EpochEvent{} -> Nothing MirEvent{} -> Nothing - TotalAdaPotsEvent{} -> Nothing \ No newline at end of file + TotalAdaPotsEvent{} -> Nothing + + +handleConwayNEWEPOCHEvents + :: EraCrypto ledgerera ~ StandardCrypto + => Core.EraPParams ledgerera + => Event (Core.EraRule "EPOCH" ledgerera) ~ Conway.ConwayEpochEvent ledgerera + => Event (Core.EraRule "POOLREAP" ledgerera) ~ ShelleyPoolreapEvent ledgerera + => Event (Core.EraRule "RUPD" ledgerera) ~ RupdEvent StandardCrypto + => ConwayNewEpochEvent ledgerera -> Maybe LedgerEvent +handleConwayNEWEPOCHEvents conwayNewEpochEvent = + case conwayNewEpochEvent of + Conway.DeltaRewardEvent rewardUpdate -> + case rewardUpdate of + RupdEvent epochNum rewards -> + Just $ IncrementalRewardsDistribution epochNum (Map.mapKeys fromShelleyStakeCredential rewards) + Conway.RestrainedRewards _ _ _ -> Nothing + Conway.TotalRewardEvent epochNo rewardsMap -> + Just $ RewardsDistribution epochNo (Map.mapKeys fromShelleyStakeCredential rewardsMap) + Conway.EpochEvent epochEvent -> + case epochEvent of + Conway.EpochBoundaryRatifyState ratifyState -> + Just $ EpochBoundaryRatificationState (AnyRatificationState ratifyState) + Conway.PoolReapEvent poolReap -> + case poolReap of + RetiredPools {refundPools, unclaimedPools, epochNo} -> + Just . PoolReap $ PoolReapDetails epochNo + (convertRetiredPoolsMap refundPools) + (convertRetiredPoolsMap unclaimedPools) + Conway.SnapEvent _ -> Nothing + Conway.TotalAdaPotsEvent _ -> Nothing + + diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/RUPD.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/RUPD.hs index 9459a59191..53aa832b5e 100644 --- a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/RUPD.hs +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/RUPD.hs @@ -1,38 +1,17 @@ module Cardano.Api.LedgerEvents.Rule.RUPD - ( handleShelleyLedgerRUPDEvents + ( handleLedgerRUPDEvents ) where -import Cardano.Api.Address (StakeCredential, fromShelleyStakeCredential) -import Cardano.Api.Block (EpochNo) -import Cardano.Api.Keys.Shelley (Hash (StakePoolKeyHash), StakePoolKey) -import Cardano.Api.Value (Lovelace, fromShelleyDeltaLovelace, fromShelleyLovelace) +import Cardano.Api.Address (fromShelleyStakeCredential) +import Cardano.Api.LedgerEvents.Rule.Types (LedgerEvent (IncrementalRewardsDistribution)) -import Cardano.Ledger.Alonzo.Plutus.TxInfo (PlutusDebug) -import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyEvent (..), AlonzoUtxoEvent (..), - AlonzoUtxosEvent (FailedPlutusScriptsEvent, SuccessfulPlutusScriptsEvent), - AlonzoUtxowEvent (..)) -import qualified Cardano.Ledger.Alonzo.Rules as Alonzo -import Cardano.Ledger.Api.Era (AllegraEra, AlonzoEra, BabbageEra, ConwayEra, MaryEra, - ShelleyEra) -import qualified Cardano.Ledger.Coin as Ledger -import qualified Cardano.Ledger.Conway.Governance as Ledger -import qualified Cardano.Ledger.Conway.Rules as Conway -import Cardano.Ledger.Core (EraCrypto) -import qualified Cardano.Ledger.Core as Ledger.Core -import qualified Cardano.Ledger.Credential as Ledger import Cardano.Ledger.Crypto (StandardCrypto) -import qualified Cardano.Ledger.Keys as Ledger -import Cardano.Ledger.Shelley.API (InstantaneousRewards (InstantaneousRewards)) -import Cardano.Ledger.Shelley.Rewards (Reward) +import Cardano.Ledger.Shelley.Rules + import qualified Data.Map.Strict as Map -import Data.Set (Set) -import qualified Cardano.Ledger.Shelley.Rules as Shelley (ShelleyLedgerEvent (UtxowEvent), - ShelleyLedgersEvent (LedgerEvent)) -import qualified Cardano.Ledger.TxIn as Ledger -import Cardano.Ledger.Shelley.Rules -import Cardano.Api.LedgerEvents.Rule.Types -handleShelleyLedgerRUPDEvents :: RupdEvent StandardCrypto -> Maybe LedgerEvent -handleShelleyLedgerRUPDEvents (RupdEvent epochNum rewards) = +handleLedgerRUPDEvents :: RupdEvent StandardCrypto -> Maybe LedgerEvent +handleLedgerRUPDEvents (RupdEvent epochNum rewards) = Just $ IncrementalRewardsDistribution epochNum (Map.mapKeys fromShelleyStakeCredential rewards) + diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/Types.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/Types.hs index b2d8705549..4c96e75f8d 100644 --- a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/Types.hs +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/Types.hs @@ -12,22 +12,27 @@ module Cardano.Api.LedgerEvents.Rule.Types , AnyRatificationState(..) , MIRDistributionDetails(..) , PoolReapDetails(..) + , convertRetiredPoolsMap ) where -import Cardano.Api.Address (StakeCredential) +import Cardano.Api.Address (StakeCredential, fromShelleyStakeCredential) import Cardano.Api.Block (EpochNo) import Cardano.Api.Keys.Shelley (Hash (..), StakePoolKey) -import Cardano.Api.Value (Lovelace) +import Cardano.Api.Value (Lovelace, fromShelleyLovelace) import Cardano.Ledger.Alonzo.Plutus.TxInfo (PlutusDebug) +import qualified Cardano.Ledger.Coin as Ledger import qualified Cardano.Ledger.Conway.Governance as Ledger import qualified Cardano.Ledger.Core as Ledger.Core +import qualified Cardano.Ledger.Credential as Ledger import Cardano.Ledger.Crypto (StandardCrypto) +import qualified Cardano.Ledger.Keys as Ledger import Cardano.Ledger.Shelley.Rewards (Reward) import qualified Cardano.Ledger.TxIn as Ledger import Data.List.NonEmpty (NonEmpty) import Data.Map.Strict (Map) +import qualified Data.Map.Strict as Map import Data.Set (Set) @@ -97,3 +102,11 @@ data PoolReapDetails = PoolReapDetails -- funds are returned to the treasury. prdUnclaimed :: Map StakeCredential (Map (Hash StakePoolKey) Lovelace) } deriving Show + + +convertRetiredPoolsMap + :: Map (Ledger.StakeCredential StandardCrypto) (Map (Ledger.KeyHash Ledger.StakePool StandardCrypto) Ledger.Coin) + -> Map StakeCredential (Map (Hash StakePoolKey) Lovelace) +convertRetiredPoolsMap = + Map.mapKeys fromShelleyStakeCredential + . fmap (Map.mapKeys StakePoolKeyHash . fmap fromShelleyLovelace) diff --git a/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/UTXOW.hs b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/UTXOW.hs new file mode 100644 index 0000000000..475a8655cb --- /dev/null +++ b/cardano-api/internal/Cardano/Api/LedgerEvents/Rule/UTXOW.hs @@ -0,0 +1,33 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module Cardano.Api.LedgerEvents.Rule.UTXOW + ( handleAlonzoOnwardsUTxOWEvent + , handlePreAlonzoUTxOWEvent + ) where + +import Cardano.Api.LedgerEvents.Rule.Types + +import Cardano.Ledger.Alonzo.Rules (AlonzoUtxoEvent (..), AlonzoUtxosEvent (..), + AlonzoUtxowEvent (..)) +import qualified Cardano.Ledger.Alonzo.Rules as Alonzo +import qualified Cardano.Ledger.Core as Ledger.Core +import qualified Cardano.Ledger.Shelley.Rules as Shelley + +import Control.State.Transition.Extended + + + +handleAlonzoOnwardsUTxOWEvent + :: Event (Ledger.Core.EraRule "UTXO" ledgerera) ~ AlonzoUtxoEvent ledgerera + => Event (Ledger.Core.EraRule "UTXOS" ledgerera) ~ AlonzoUtxosEvent ledgerera + => AlonzoUtxowEvent ledgerera -> Maybe LedgerEvent +handleAlonzoOnwardsUTxOWEvent (WrappedShelleyEraEvent (Shelley.UtxoEvent (UtxosEvent utxoEvent))) = + case utxoEvent of + Alonzo.AlonzoPpupToUtxosEvent{} -> Nothing + Alonzo.TotalDeposits{} -> Nothing + Alonzo.SuccessfulPlutusScriptsEvent{} -> Nothing + Alonzo.FailedPlutusScriptsEvent{} -> Nothing + +handlePreAlonzoUTxOWEvent :: Shelley.ShelleyUtxowEvent ledgerera -> Maybe LedgerEvent +handlePreAlonzoUTxOWEvent = error "TODO"