diff --git a/cabal.project b/cabal.project index 30e3386d520..4efa9734650 100644 --- a/cabal.project +++ b/cabal.project @@ -53,7 +53,7 @@ package cardano-node-chairman ghc-options: -Werror package cardano-node - ghc-options: -Werror + ghc-options: -Wwarn package cardano-submit-api ghc-options: -Werror diff --git a/cardano-node/app/cardano-events.hs b/cardano-node/app/cardano-events.hs index e54d5335eb5..5cf7df48361 100644 --- a/cardano-node/app/cardano-events.hs +++ b/cardano-node/app/cardano-events.hs @@ -1,5 +1,6 @@ import System.Environment -import Cardano.Node.LedgerEvent (tailEvent) +import Cardano.Node.LedgerEvent (foldEvent, filterRewards) +import System.IO(stdin) main :: IO () -main = getArgs >>= tailEvent . head +main = foldEvent filterRewards mempty stdin diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal index 60b8e4ef39d..7b8dc1ad2c1 100644 --- a/cardano-node/cardano-node.cabal +++ b/cardano-node/cardano-node.cabal @@ -137,6 +137,7 @@ library , aeson >= 1.5.6.0 , async , base16-bytestring + , binary , bytestring , cardano-api ^>= 8.2 , cardano-crypto-class diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs index d161f15a8a7..efb401e40c0 100644 --- a/cardano-node/src/Cardano/Node/LedgerEvent.hs +++ b/cardano-node/src/Cardano/Node/LedgerEvent.hs @@ -30,17 +30,19 @@ module Cardano.Node.LedgerEvent ( , eventCodecVersion , deserializeEvent , serializeEvent - , foldEvent + , foldEvent, filterRewards ) where import Cardano.Prelude hiding (All, Sum) +import Data.Binary.Get(runGetOrFail) import Cardano.Ledger.Binary (DecCBOR(..), EncCBOR(..), Version, fromCBOR, serialize', toCBOR, toPlainDecoder) import Cardano.Ledger.Binary.Coders (Decode(..), Encode (..), encode, (!>), ( IO (LBS.ByteString, a) unsafeDeserialiseFromBytes decoder = either (panic . show) pure . deserialiseFromBytes decoder + +filterRewards :: Coin -> AnchoredEvent -> IO Coin +filterRewards current = \case + AnchoredEvent{ledgerEvent = LedgerTotalRewards epoch rewardsMap} -> + pure $ maybe current ((<> current) . rewardsToCoin) $ Map.lookup stakeCred rewardsMap + _ -> pure current + + where + rewardsToCoin = Set.foldr (<>) mempty . Set.map Ledger.rewardAmount + + stakeCred = fromMaybe (panic "should not happen") $ do + case Hex.decode "e04cf4f01890215bd181d1fcd3c9589a2a4a3adbcff1a70b748080fa82" of + Right bytes -> Ledger.getRwdCred <$> Ledger.decodeRewardAcnt bytes + Left err -> panic (show err)