From 1ce6ef69b4dc0ed21e5679ba358780ad35d6c76e Mon Sep 17 00:00:00 2001 From: KtorZ Date: Fri, 22 Sep 2023 14:34:46 +0200 Subject: [PATCH] Remove patterns, unneeded noise in this context. --- cardano-node/src/Cardano/Node/LedgerEvent.hs | 115 +++---------------- 1 file changed, 15 insertions(+), 100 deletions(-) diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index dd761682580..570ffbd964b 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -264,17 +264,21 @@ toLedgerEventShelley -> Maybe (LedgerEvent (EraCrypto era)) toLedgerEventShelley evt = case unwrapLedgerEvent evt of - LETotalRewards e m -> - Just $ LedgerTotalRewards e m - LERestraintRewards e m creds -> - Just $ LedgerRestrainedRewards e m creds - LEDeltaReward e m -> - Just $ LedgerDeltaRewards e m - LEIncrementalReward e m -> - Just $ LedgerIncrementalRewards e m - LEMirTransfer fromReserve fromTreasury deltaReserve deltaTreasury -> - Just $ LedgerMirDist fromReserve fromTreasury deltaReserve deltaTreasury - LERetiredPools refunded unclaimed epoch -> + ShelleyLedgerEventTICK (TickNewEpochEvent (Shelley.TotalRewardEvent epoch rewards)) -> + Just $ LedgerTotalRewards epoch rewards + ShelleyLedgerEventTICK (TickNewEpochEvent (Shelley.RestrainedRewards epoch rewards credentials)) -> + Just $ LedgerRestrainedRewards epoch rewards credentials + ShelleyLedgerEventTICK (TickNewEpochEvent (Shelley.DeltaRewardEvent (RupdEvent epoch rewards))) -> + Just $ LedgerDeltaRewards epoch rewards + ShelleyLedgerEventTICK (TickRupdEvent (RupdEvent epoch rewards)) -> + Just $ LedgerIncrementalRewards epoch rewards + ShelleyLedgerEventTICK (TickNewEpochEvent (Shelley.MirEvent transfer)) -> + case transfer of + MirTransfer (InstantaneousRewards fromReserve fromTreasury deltaReserve deltaTreasury) -> + Just $ LedgerMirDist fromReserve fromTreasury deltaReserve deltaTreasury + NoMirTransfer{} -> -- FIXME: create an event for this + Nothing + ShelleyLedgerEventTICK (TickNewEpochEvent (Shelley.EpochEvent (PoolReapEvent (RetiredPools refunded unclaimed epoch)))) -> Just $ LedgerPoolReaping epoch refunded unclaimed ShelleyLedgerEventBBODY {} -> Just LedgerBody @@ -312,95 +316,6 @@ eventCodecVersion = \case OneEraLedgerEvent ( S(S(S(S(S(Z{}))))) ) -> eraProtVerLow @(BabbageEra crypto) OneEraLedgerEvent (S(S(S(S(S(S(Z{}))))))) -> eraProtVerLow @(ConwayEra crypto) --------------------------------------------------------------------------------- --- Patterns for event access. Why aren't these in ledger-specs? - -pattern LERestraintRewards :: - ( Event (Ledger.EraRule "TICK" era) ~ ShelleyTickEvent era - , Event (Ledger.EraRule "NEWEPOCH" era) ~ ShelleyNewEpochEvent era - ) => - EpochNo -> - Map (StakeCredential (EraCrypto era)) (Set (Reward (EraCrypto era))) -> - Set (StakeCredential (EraCrypto era)) -> - AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) -pattern LERestraintRewards e m creds <- - ShelleyLedgerEventTICK - (TickNewEpochEvent (Shelley.RestrainedRewards e m creds)) - -pattern LETotalRewards :: - ( Event (Ledger.EraRule "TICK" era) ~ ShelleyTickEvent era - , Event (Ledger.EraRule "NEWEPOCH" era) ~ ShelleyNewEpochEvent era - ) => - EpochNo -> - Map (StakeCredential (EraCrypto era)) (Set (Reward (EraCrypto era))) -> - AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) -pattern LETotalRewards e m <- - ShelleyLedgerEventTICK - (TickNewEpochEvent (Shelley.TotalRewardEvent e m)) - -pattern LEDeltaReward :: - ( Event (Ledger.EraRule "TICK" era) ~ ShelleyTickEvent era - , Event (Ledger.EraRule "NEWEPOCH" era) ~ ShelleyNewEpochEvent era - , Event (Ledger.EraRule "RUPD" era) ~ RupdEvent (EraCrypto era) - ) => - EpochNo -> - Map (StakeCredential (EraCrypto era)) (Set (Reward (EraCrypto era))) -> - AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) -pattern LEDeltaReward e m <- - ShelleyLedgerEventTICK - (TickNewEpochEvent (Shelley.DeltaRewardEvent (RupdEvent e m))) - -pattern LEIncrementalReward :: - ( Event (Ledger.EraRule "TICK" era) ~ ShelleyTickEvent era - , Event (Ledger.EraRule "RUPD" era) ~ RupdEvent (EraCrypto era) - ) => - EpochNo -> - Map (StakeCredential (EraCrypto era)) (Set (Reward (EraCrypto era))) -> - AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) -pattern LEIncrementalReward e m <- - ShelleyLedgerEventTICK - (TickRupdEvent (RupdEvent e m)) - -pattern LEMirTransfer :: - ( Event (Ledger.EraRule "TICK" era) ~ ShelleyTickEvent era - , Event (Ledger.EraRule "NEWEPOCH" era) ~ ShelleyNewEpochEvent era - , Event (Ledger.EraRule "MIR" era) ~ ShelleyMirEvent era - ) => - Map (StakeCredential (EraCrypto era)) Coin -> - Map (StakeCredential (EraCrypto era)) Coin -> - DeltaCoin -> - DeltaCoin -> - AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) -pattern LEMirTransfer rp tp rtt ttr <- - ShelleyLedgerEventTICK - ( TickNewEpochEvent - ( Shelley.MirEvent - ( MirTransfer - (InstantaneousRewards rp tp rtt ttr) - ) - ) - ) - -pattern LERetiredPools :: - ( Event (Ledger.EraRule "TICK" era) ~ ShelleyTickEvent era - , Event (Ledger.EraRule "NEWEPOCH" era) ~ ShelleyNewEpochEvent era - , Event (Ledger.EraRule "EPOCH" era) ~ ShelleyEpochEvent era - , Event (Ledger.EraRule "POOLREAP" era) ~ ShelleyPoolreapEvent era - ) => - Map (StakeCredential (EraCrypto era)) (Map (KeyHash 'StakePool (EraCrypto era)) Coin) -> - Map (StakeCredential (EraCrypto era)) (Map (KeyHash 'StakePool (EraCrypto era)) Coin) -> - EpochNo -> - AuxLedgerEvent (LedgerState (ShelleyBlock proto era)) -pattern LERetiredPools r u e <- - ShelleyLedgerEventTICK - ( TickNewEpochEvent - ( Shelley.EpochEvent - ( PoolReapEvent - (RetiredPools r u e) - ) - ) - ) - data AnchoredEvent = AnchoredEvent { headerHash :: ShortByteString