From a74045ae06141f1783e6fab084162d2c8c944860 Mon Sep 17 00:00:00 2001
From: Arnaud Bailly <arnaud.bailly@iohk.io>
Date: Fri, 22 Sep 2023 11:22:13 +0200
Subject: [PATCH] Filter ledger event for given stake address

---
 cabal.project                                |  2 +-
 cardano-node/app/cardano-events.hs           |  5 +++--
 cardano-node/cardano-node.cabal              |  1 +
 cardano-node/src/Cardano/Node/LedgerEvent.hs | 20 +++++++++++++++++++-
 4 files changed, 24 insertions(+), 4 deletions(-)

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, (!>),
                    (<!), decode)
 import           Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import qualified Cardano.Ledger.Core as Ledger
+import qualified Cardano.Ledger.Address as Ledger
 import           Cardano.Ledger.Core (eraProtVerLow)
 import qualified Cardano.Ledger.Credential as Ledger
 import           Cardano.Ledger.Crypto (Crypto, StandardCrypto)
@@ -59,6 +61,7 @@ import           Codec.CBOR.Read(deserialiseFromBytes)
 import           Control.State.Transition (Event)
 import           Data.ByteString.Short(ShortByteString)
 import qualified Data.ByteString.Lazy as LBS
+import qualified Data.ByteString.Base16 as Hex
 import qualified Data.Map.Strict as Map
 import           Data.SOP.Strict (All, K (..), NS(..), hcmap, hcollapse)
 import qualified Data.Set as Set
@@ -181,6 +184,7 @@ type StakeCred = Ledger.StakeCredential StandardCrypto
 -- The `ledger-specs` code defines a `RewardUpdate` type that is parameterised over
 -- Shelley/Allegra/Mary. This is a huge pain in the neck for `db-sync` so we define a
 -- generic one instead.
+-- FIXME: use directly ledger types instead of wrapping them
 newtype Rewards = Rewards
   { unRewards :: Map StakeCred (Set Reward)
   }
@@ -511,3 +515,17 @@ foldEvent fn st0 h =
       -> 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)