Small refactor to enhance readability and avoid opening unnecessary s…

…ocket.
CardanoSolutions · Sep 26, 2023 · 091ca88 · 091ca88
1 parent dc5a6b4
commit 091ca88
Show file tree

Hide file tree

Showing 2 changed files with 22 additions and 21 deletions.
diff --git a/cardano-node/src/Cardano/Node/LedgerEvent.hs b/cardano-node/src/Cardano/Node/LedgerEvent.hs
@@ -80,7 +80,8 @@ import           Ouroboros.Consensus.Cardano.Block (AllegraEra, AlonzoEra,
 import           Ouroboros.Consensus.HardFork.Combinator.AcrossEras
                      (OneEraLedgerEvent(..), getOneEraHash, getOneEraLedgerEvent)
 import           Ouroboros.Consensus.Ledger.Abstract (AuxLedgerEvent,
-                     LedgerState, LedgerEventHandler(..))
+                     LedgerEventHandler(..))
+import qualified Ouroboros.Consensus.Ledger.Abstract as Abstract
 import           Ouroboros.Consensus.Ledger.Extended (ExtLedgerState)
 import           Ouroboros.Consensus.Shelley.Ledger (ShelleyBlock,
                      ShelleyLedgerEvent (..))
@@ -89,6 +90,9 @@ import           System.IO(hIsEOF)
 import Cardano.Ledger.Conway.Rules (ConwayNewEpochEvent, ConwayEpochEvent)
 import qualified Cardano.Ledger.Conway.Rules as Conway
 
+type LedgerState crypto =
+  ExtLedgerState (HardForkBlock (CardanoEras crypto))
+
 data LedgerEvent crypto
   = LedgerNewEpochEvent !(LedgerNewEpochEvent crypto)
   -- TODO complete those vvv
@@ -100,6 +104,9 @@ data LedgerEvent crypto
   | LedgerTick
   deriving (Eq, Show)
 
+-- TODO(KtorZ): Discuss that design choice; I believe we should favor a more
+-- 'flat' structure for events instead of preserving whatever the ledger imposes
+-- on us.
 data LedgerNewEpochEvent crypto
   = LedgerMirDist
       !(Map (StakeCredential crypto) Coin)
@@ -117,7 +124,8 @@ data LedgerNewEpochEvent crypto
         -- ^ Stake pools refunds after retirement
       !(Map (Credential 'Staking crypto) (Map (KeyHash 'StakePool crypto) Coin))
         -- ^ Unclaimed deposit after retirement, for stake credentials that no longer exist.
-  | LedgerStakeDistEvent !(Map (Credential 'Staking crypto) (Coin, KeyHash 'StakePool crypto))
+  | LedgerStakeDistEvent
+      !(Map (Credential 'Staking crypto) (Coin, KeyHash 'StakePool crypto))
   | LedgerIncrementalRewards
       !EpochNo
       !(Map (StakeCredential crypto) (Set (Reward crypto)))
@@ -259,7 +267,7 @@ ledgerNewEpochEventName = \case
 
 fromAuxLedgerEvent
   :: forall xs crypto. (All ConvertLedgerEvent xs, crypto ~ StandardCrypto)
-  => AuxLedgerEvent (LedgerState (HardForkBlock xs))
+  => AuxLedgerEvent (Abstract.LedgerState (HardForkBlock xs))
   -> Maybe (LedgerEvent crypto)
 fromAuxLedgerEvent =
   toLedgerEvent . WrapLedgerEvent @(HardForkBlock xs)
@@ -469,12 +477,11 @@ filterRewards credential st = \case
 
 withLedgerEventsServerStream
   :: PortNumber
-  -> (LedgerEventHandler IO (ExtLedgerState (HardForkBlock (CardanoEras StandardCrypto))) -> IO ())
+  -> (LedgerEventHandler IO (LedgerState StandardCrypto) -> IO ())
   -> IO ()
 withLedgerEventsServerStream port handler = do
   withSocketsDo $ do
     bracket open closeSockets go
-
  where
   go s = do
     h <- socketToHandle s WriteMode

diff --git a/cardano-node/src/Cardano/Node/Run.hs b/cardano-node/src/Cardano/Node/Run.hs
@@ -173,22 +173,16 @@ runNode cmdPc = do
               let ProtocolInfo { pInfoConfig } = Api.protocolInfo runP
               in getNetworkMagic $ Consensus.configBlock pInfoConfig
 
-    case p of
-      SomeConsensusProtocol blk runP ->
-        case ncLedgerEventHandlerPort nc of
-          Nothing ->
-            handleNodeWithTracers
-              discardEvent
-              cmdPc nc p networkMagic runP
-          Just port ->
-            withLedgerEventsServerStream (fromIntegral port) $ \ledgerEventHandler ->
-                handleNodeWithTracers
-                  (case blk of
-                    Api.CardanoBlockType -> ledgerEventHandler
-                    Api.ByronBlockType{} -> discardEvent
-                    Api.ShelleyBlockType{} -> discardEvent
-                  )
-                  cmdPc nc p networkMagic runP
+    case (p, ncLedgerEventHandlerPort nc) of
+      (SomeConsensusProtocol Api.CardanoBlockType runP, Just port) ->
+        withLedgerEventsServerStream (fromIntegral port) $ \ledgerEventHandler ->
+          handleNodeWithTracers
+            ledgerEventHandler
+            cmdPc nc p networkMagic runP
+      (SomeConsensusProtocol _ runP, _) ->
+        handleNodeWithTracers
+          discardEvent
+          cmdPc nc p networkMagic runP
 
 -- | Workaround to ensure that the main thread throws an async exception on
 -- receiving a SIGTERM signal.