Updated ouroboros-consensus and move client-related function out of C…

…ardano.Node.LedgerEvent * Updated ouroboros-consensus to latest changes wrt LedgerEventHandler * Move foldEvent and filterReward functions out of Cardano.Node.LedgerEvent
CardanoSolutions · Oct 6, 2023 · d7eb876 · d7eb876
1 parent a01ee64
commit d7eb876
Show file tree

Hide file tree

Showing 6 changed files with 72 additions and 55 deletions.
diff --git a/cabal.project b/cabal.project
@@ -83,8 +83,8 @@ constraints:
 source-repository-package
     type: git
     location: https://github.com/CardanoSolutions/ouroboros-consensus
-    tag: 26cfb9666efd78692912fbdcc41e927f64f282ae
-    --sha256: 0p4axag77by7bwc3wnbdphpc6ib57b0di4clzcb8c0za0gf1sw46
+    tag: 2fe143f6750180aac22c13d64efa5f0caabe4d89
+    --sha256: 169lvgq44r1w4ldbarr1md45raf3i69sca75m65vn55l3jjz4i67
     subdir:
       ouroboros-consensus
       ouroboros-consensus-cardano

diff --git a/cardano-node/app/reward-history.hs b/cardano-node/app/reward-history.hs
@@ -1,16 +1,24 @@
 {-# LANGUAGE LambdaCase #-}
+{-# LANGUAGE DataKinds #-}
 
 import Cardano.Node.LedgerEvent (
-    AnchoredEvent (AnchoredEvent),
+    AnchoredEvent (AnchoredEvent, ledgerEvent),
     LedgerEvent (LedgerNewEpochEvent),
-    LedgerNewEpochEvent (LedgerStakeDistEvent),
-    foldEvent,
-    parseStakeCredential,
+    LedgerNewEpochEvent (LedgerStakeDistEvent, LedgerTotalRewards),
+    foldEvent, Credential, KeyRole (Staking), StandardCrypto, EpochNo, Coin
  )
 import Control.Exception (bracket, bracketOnError)
 import Network.Socket
 import System.Environment (getArgs)
 import System.IO (IOMode (ReadMode))
+import Data.Map (Map)
+import qualified Data.Map as Map
+import qualified Data.Set as Set
+import qualified Cardano.Node.LedgerEvent as Ledger
+import qualified Data.ByteString.Base16 as Hex
+import qualified Data.ByteString.Char8 as B8
+import qualified Cardano.Ledger.Address as Ledger
+import Data.Function ((&))
 
 -- Usage: reward-history <<<stdin LEDGER-EVENTS] <STAKE-ADDRESS>
 --
@@ -28,7 +36,7 @@ main = do
         putStrLn "Getting reward history..."
         -- void $ foldEvent h mempty $ \st e -> let r = filterRewards stakeCredential st e in print r >> pure r
         -- void $ foldEvent h mempty $ \st e -> let r = filterRewards stakeCredential st e in print r >> pure r
-        foldEvent h () $ \() -> \case AnchoredEvent _ _ (LedgerNewEpochEvent (LedgerStakeDistEvent e)) -> print e; _otherEvent -> pure ()
+        foldEvent h () $ \() -> \case ae@(AnchoredEvent _ _ _ _ (LedgerNewEpochEvent (LedgerStakeDistEvent _))) -> print ae; _otherEvent -> pure ()
   where
     expectStakeCredential =
         maybe (error "invalid / missing stake address as 1st argument") return
@@ -46,3 +54,24 @@ runTCPClient host port client = withSocketsDo $ do
     open addr = bracketOnError (openSocket addr) close $ \sock -> do
         connect sock $ addrAddress addr
         return sock
+
+filterRewards
+  :: Credential 'Staking StandardCrypto
+  -> Map EpochNo Coin
+  -> AnchoredEvent
+  -> Map EpochNo Coin
+filterRewards credential st = \case
+  AnchoredEvent{ledgerEvent = LedgerNewEpochEvent (LedgerTotalRewards epoch rewardsMap)} ->
+    let update = Map.lookup credential rewardsMap
+          & maybe id (Map.insert epoch . mergeRewards)
+     in update st
+  _otherEvent -> st
+ where
+   mergeRewards = Set.foldr (<>) mempty . Set.map Ledger.rewardAmount
+
+-- | Parse a 'Credential 'Staking' from a stake address in base16.
+parseStakeCredential :: String -> Maybe (Credential 'Staking StandardCrypto)
+parseStakeCredential str =
+   case Hex.decode (B8.pack str) of
+     Right bytes -> Ledger.getRwdCred <$> Ledger.decodeRewardAcnt bytes
+     Left{} -> Nothing
diff --git a/cardano-node/cardano-node.cabal b/cardano-node/cardano-node.cabal
@@ -235,6 +235,10 @@ executable reward-history
   build-depends:        base >= 4.14 && < 4.17
                       , cardano-node
                       , network
+                      , containers
+                      , bytestring
+                      , base16-bytestring
+                      , cardano-ledger-core
 
 test-suite cardano-node-test
   import:               project-config

diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs
@@ -31,10 +31,6 @@ module Cardano.Node.LedgerEvent (
   , withLedgerEventsServerStream
   , foldEvent
 
-    -- ** Example
-  , filterRewards
-  , parseStakeCredential
-
     -- * Type-level plumbing
   , ConvertLedgerEvent (..)
   , eventCodecVersion
@@ -49,6 +45,7 @@ module Cardano.Node.LedgerEvent (
   , Reward (..)
   , ScriptHash (..)
   , SlotNo (..)
+  , BlockNo (..)
   , StandardCrypto
   , serialize'
   ) where
@@ -64,7 +61,6 @@ import           Cardano.Ledger.Coin (Coin (..), DeltaCoin (..))
 import           Cardano.Ledger.Credential (Credential (..))
 import           Cardano.Ledger.Rewards (Reward(..))
 import qualified Cardano.Ledger.Core as Ledger
-import qualified Cardano.Ledger.Address as Ledger
 import           Cardano.Ledger.Core (eraProtVerLow)
 import           Cardano.Ledger.Crypto (Crypto, StandardCrypto)
 import           Cardano.Ledger.Keys (KeyRole (..))
@@ -76,18 +72,16 @@ import           Cardano.Ledger.Shelley.Rules (RupdEvent (..),
                      ShelleyEpochEvent (..), ShelleyMirEvent (..),
                      ShelleyNewEpochEvent, ShelleyPoolreapEvent (..),
                      ShelleyTickEvent (..))
-import           Cardano.Slotting.Slot (SlotNo (..), EpochNo (..))
+import           Cardano.Slotting.Slot (SlotNo (..), EpochNo (..), WithOrigin (..))
+import           Cardano.Slotting.Block (BlockNo(..))
 import qualified Codec.CBOR.Decoding as CBOR
 import qualified Codec.CBOR.Encoding as CBOR
 import qualified Codec.CBOR.Read as CBOR
 import qualified Codec.CBOR.Write as CBOR
 import           Control.State.Transition (Event)
 import           Data.ByteString.Short(ShortByteString)
-import qualified Data.ByteString.Char8 as B8
 import qualified Data.ByteString.Lazy as LBS
 import qualified Data.ByteString  as BS
-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
 import           Data.String (String)
@@ -113,6 +107,7 @@ import qualified Cardano.Ledger.Conway.Rules as Conway
 import qualified Cardano.Ledger.Shelley.API as ShelleyAPI
 import Cardano.Ledger.Alonzo.Rules (AlonzoBbodyEvent (ShelleyInAlonzoEvent), AlonzoUtxowEvent (WrappedShelleyEraEvent), AlonzoUtxoEvent (UtxosEvent), AlonzoUtxosEvent)
 import GHC.IO.Exception (IOException(IOError, ioe_type), IOErrorType (ResourceVanished))
+import Ouroboros.Network.Block (ChainHash(GenesisHash, BlockHash))
 
 type LedgerState crypto =
   ExtLedgerState (HardForkBlock (CardanoEras crypto))
@@ -307,13 +302,6 @@ instance Crypto crypto => DecCBOR (LedgerRewardUpdateEvent crypto) where
       decRaw n =
         Invalid n
 
--- | Parse a 'Credential 'Staking' from a stake address in base16.
-parseStakeCredential :: String -> Maybe (Credential 'Staking StandardCrypto)
-parseStakeCredential str =
-   case Hex.decode (B8.pack str) of
-     Right bytes -> Ledger.getRwdCred <$> Ledger.decodeRewardAcnt bytes
-     Left{} -> Nothing
-
 instance Ord (LedgerEvent crypto) where
   a <= b = toOrdering a <= toOrdering b
 
@@ -710,17 +698,21 @@ eventCodecVersion = \case
 
 data AnchoredEvent =
   AnchoredEvent
-    { headerHash :: !ShortByteString
+    { prevBlockHeaderHash :: !(WithOrigin ShortByteString)
+    , blockHeaderHash :: !ShortByteString
     , slotNo :: !SlotNo
+    , blockNo :: !BlockNo
     , ledgerEvent :: !(LedgerEvent StandardCrypto)
     }
   deriving (Eq, Show)
 
 instance EncCBOR AnchoredEvent where
-  encCBOR AnchoredEvent{headerHash, slotNo, ledgerEvent} =
+  encCBOR AnchoredEvent{prevBlockHeaderHash, blockHeaderHash , slotNo, blockNo, ledgerEvent} =
     encode $ Rec AnchoredEvent
-      !> To headerHash
+      !> To prevBlockHeaderHash
+      !> To blockHeaderHash
       !> To slotNo
+      !> To blockNo
       !> To ledgerEvent
 
 instance DecCBOR AnchoredEvent where
@@ -729,6 +721,8 @@ instance DecCBOR AnchoredEvent where
       <! From
       <! From
       <! From
+      <! From
+      <! From
 
 serializeAnchoredEvent :: Version -> AnchoredEvent -> ByteString
 serializeAnchoredEvent version event =
@@ -772,23 +766,9 @@ foldEvent h st0 fn =
         st' <- fn st event
         go st' events
 
-filterRewards
-  :: Credential 'Staking StandardCrypto
-  -> Map EpochNo Coin
-  -> AnchoredEvent
-  -> Map EpochNo Coin
-filterRewards credential st = \case
-  AnchoredEvent{ledgerEvent = LedgerNewEpochEvent (LedgerTotalRewards epoch rewardsMap)} ->
-    let update = Map.lookup credential rewardsMap
-          & maybe identity (Map.insert epoch . mergeRewards)
-     in update st
-  _otherEvent -> st
- where
-   mergeRewards = Set.foldr (<>) mempty . Set.map Ledger.rewardAmount
-
 withLedgerEventsServerStream
   :: PortNumber
-  -> (LedgerEventHandler IO (LedgerState StandardCrypto) -> IO ())
+  -> (LedgerEventHandler IO (LedgerState StandardCrypto) (HardForkBlock (CardanoEras crypto)) -> IO ())
   -> IO ()
 withLedgerEventsServerStream port handler = do
   withSocketsDo $ do
@@ -808,15 +788,18 @@ withLedgerEventsServerStream port handler = do
 
   closeSockets = close
 
-  writeLedgerEvents h headerHash slotNo event = do
-    case fromAuxLedgerEvent event of
-      Nothing -> pure ()
-      Just e -> do
-        let anchoredEvent = AnchoredEvent (getOneEraHash headerHash) slotNo e
-        catch (BS.hPut h $ serializeAnchoredEvent (eventCodecVersion event) anchoredEvent) $ \case
-          -- If the client closes the socket, we continue running the node, but ignore the events.
-          IOError { ioe_type = ResourceVanished } -> do
-            pure ()
-          err -> do
-            print err
-            throwIO err
+  writeLedgerEvents h ph headerHash slotNo blockNo events = do
+    forM_ events $ \event -> do
+      case fromAuxLedgerEvent event of
+        Nothing -> pure ()
+        Just e -> do
+          let chainHashToHeaderHash GenesisHash = Origin
+              chainHashToHeaderHash (BlockHash bh) = At bh
+          let anchoredEvent = AnchoredEvent (getOneEraHash <$> chainHashToHeaderHash ph) (getOneEraHash headerHash) slotNo blockNo e
+          catch (BS.hPut h $ serializeAnchoredEvent (eventCodecVersion event) anchoredEvent) $ \case
+            -- If the client closes the socket, we continue running the node, but ignore the events.
+            IOError { ioe_type = ResourceVanished } -> do
+              pure ()
+            err -> do
+              print err
+              throwIO err
diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
@@ -206,7 +206,7 @@ handleNodeWithTracers
   :: ( TraceConstraints blk
      , Api.Protocol IO blk
      )
-  => LedgerEventHandler IO (ExtLedgerState blk)
+  => LedgerEventHandler IO (ExtLedgerState blk) blk
   -> PartialNodeConfiguration
   -> NodeConfiguration
   -> SomeConsensusProtocol
@@ -343,7 +343,7 @@ handlePeersListSimple tr nodeKern = forever $ do
 
 handleSimpleNode
   :: forall blk p2p . Api.Protocol IO blk
-  => LedgerEventHandler IO (ExtLedgerState blk)
+  => LedgerEventHandler IO (ExtLedgerState blk) blk
   -> Api.ProtocolInfoArgs IO blk
   -> NetworkP2PMode p2p
   -> Tracers RemoteConnectionId LocalConnectionId blk p2p

diff --git a/nix/haskell.nix b/nix/haskell.nix
@@ -46,6 +46,7 @@ let
           cabal
           tullia
           nix-systems
+          pkgs.cargo
         ];
 
         withHoogle = true;