Extensible Ouroboros Network Diffusion Stack

cabal.project

@@ -18,7 +18,7 @@ index-state:
   , hackage.haskell.org 2024-12-10T16:20:07Z
 
   -- Bump this if you need newer packages from CHaP
-  , cardano-haskell-packages 2024-09-26T15:16:07Z
+  , cardano-haskell-packages 2024-11-26T16:00:26Z
 
 packages: ./cardano-ping
           ./monoidal-synchronisation

nix/ouroboros-network.nix

@@ -90,7 +90,7 @@ let
         preCheck =
           lib.mkForce
             (if buildSystem == "x86_64-linux"
-            then "export GHCRTS=-M300M"
+            then "export GHCRTS=-M400M"
             else "");
         doCheck = !pkgs.stdenv.hostPlatform.isWindows;
 

ouroboros-network-api/CHANGELOG.md

@@ -5,6 +5,15 @@
 ### Breaking changes
 
 * Added `NodeToClientV_20`.
+- Moved `Ouroboros.Network.ConsensusMode` to `Cardano.Network.ConsensusMode`
+- Moved `Ouroboros.Network.PeerSelection.Bootstrap` to `Cardano.Network.PeerSelection.Bootstrap`
+- Moved `Ouroboros.Network.PeerSelection.LocalRootPeers` to `Cardano.Network.PeerSelection.LocalRootPeers`
+- Moved `Ouroboros.Network.PeerSelection.PeerTrustable` to `Cardano.Network.PeerSelection.PeerTrustable`
+- Created `Cardano.Network.Types` and moved Cardano specific types such as
+  `LedgerStateJudgement` and `NumberOfBigLedgerPeers` from
+  `Ouroboros.Network.PeerSelection.LedgerPeers/Type` to there.
+- Removed `lpGetLedgerStateJudgment` from `LedgerConsensusInterface` and added
+  `extraAPI` type parameter to it.
 
 ### Non-breaking changes
 

ouroboros-network-api/ouroboros-network-api.cabal

@@ -23,28 +23,29 @@ flag asserts
 library
   hs-source-dirs: src
   exposed-modules:
+    Cardano.Network.ConsensusMode
+    Cardano.Network.PeerSelection.Bootstrap
+    Cardano.Network.PeerSelection.LocalRootPeers
+    Cardano.Network.PeerSelection.PeerTrustable
+    Cardano.Network.Types
     Ouroboros.Network.AnchoredFragment
     Ouroboros.Network.AnchoredSeq
     Ouroboros.Network.Block
     Ouroboros.Network.BlockFetch.ConsensusInterface
     Ouroboros.Network.CodecCBORTerm
-    Ouroboros.Network.ConsensusMode
     Ouroboros.Network.ControlMessage
     Ouroboros.Network.Handshake
     Ouroboros.Network.Handshake.Acceptable
     Ouroboros.Network.Handshake.Queryable
     Ouroboros.Network.Magic
     Ouroboros.Network.NodeToClient.Version
     Ouroboros.Network.NodeToNode.Version
-    Ouroboros.Network.PeerSelection.Bootstrap
     Ouroboros.Network.PeerSelection.LedgerPeers.Type
     Ouroboros.Network.PeerSelection.LedgerPeers.Utils
-    Ouroboros.Network.PeerSelection.LocalRootPeers
     Ouroboros.Network.PeerSelection.PeerAdvertise
     Ouroboros.Network.PeerSelection.PeerMetric.Type
     Ouroboros.Network.PeerSelection.PeerSharing
     Ouroboros.Network.PeerSelection.PeerSharing.Codec
-    Ouroboros.Network.PeerSelection.PeerTrustable
     Ouroboros.Network.PeerSelection.RelayAccessPoint
     Ouroboros.Network.Point
     Ouroboros.Network.Protocol.Limits

ouroboros-network-api/src/Ouroboros/Network/ConsensusMode.hs → ouroboros-network-api/src/Cardano/Network/ConsensusMode.hs

@@ -1,7 +1,7 @@
 {-# LANGUAGE DeriveAnyClass #-}
 {-# LANGUAGE DeriveGeneric  #-}
 
-module Ouroboros.Network.ConsensusMode where
+module Cardano.Network.ConsensusMode where
 
 import Data.Aeson
 import GHC.Generics (Generic)

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/Bootstrap.hs → ouroboros-network-api/src/Cardano/Network/PeerSelection/Bootstrap.hs

@@ -1,16 +1,15 @@
 {-# LANGUAGE DeriveGeneric     #-}
 {-# LANGUAGE OverloadedStrings #-}
 
-module Ouroboros.Network.PeerSelection.Bootstrap
+module Cardano.Network.PeerSelection.Bootstrap
   ( UseBootstrapPeers (..)
   , isBootstrapPeersEnabled
   , requiresBootstrapPeers
   , isNodeAbleToMakeProgress
   ) where
 
+import Cardano.Network.Types (LedgerStateJudgement (..))
 import GHC.Generics (Generic)
-import Ouroboros.Network.PeerSelection.LedgerPeers.Type
-           (LedgerStateJudgement (..))
 import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint)
 
 data UseBootstrapPeers = DontUseBootstrapPeers

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LocalRootPeers.hs → ouroboros-network-api/src/Cardano/Network/PeerSelection/LocalRootPeers.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 
-module Ouroboros.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState (..)) where
+module Cardano.Network.PeerSelection.LocalRootPeers (OutboundConnectionsState (..)) where
 
 import GHC.Generics
 import NoThunks.Class

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/PeerTrustable.hs → ouroboros-network-api/src/Cardano/Network/PeerSelection/PeerTrustable.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE DeriveGeneric #-}
 
-module Ouroboros.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) where
+module Cardano.Network.PeerSelection.PeerTrustable (PeerTrustable (..)) where
 
 import GHC.Generics (Generic)
 

ouroboros-network-api/src/Cardano/Network/Types.hs

@@ -0,0 +1,29 @@
+{-# LANGUAGE DeriveGeneric              #-}
+{-# LANGUAGE DerivingStrategies         #-}
+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
+
+module Cardano.Network.Types where
+
+import Data.Aeson (FromJSON)
+import GHC.Generics (Generic)
+import NoThunks.Class (NoThunks)
+
+-- | Wether the node is caught up or fell too far behind the chain
+data LedgerStateJudgement = YoungEnough | TooOld
+  deriving (Eq, Show, Generic)
+
+instance NoThunks LedgerStateJudgement
+
+-- | Minimum number of hot big ledger peers in Genesis mode
+--   for trusted state to be signalled to Consensus. This number
+--   should be smaller than the `targetNumberOfActiveBigLedgerPeers`
+--   but greater than 1. In Genesis, we may demote a big ledger peer
+--   for underperformance, but not promote a replacement immediately
+--   to guard against adversaries which may want to slow down our
+--   progress.
+--
+newtype NumberOfBigLedgerPeers =
+  NumberOfBigLedgerPeers { getNumberOfBigLedgerPeers :: Int }
+  deriving stock (Eq, Show)
+  deriving newtype (FromJSON)
+

ouroboros-network-api/src/Ouroboros/Network/BlockFetch/ConsensusInterface.hs

@@ -23,11 +23,10 @@ import GHC.Generics (Generic)
 import GHC.Stack (HasCallStack)
 import NoThunks.Class (NoThunks)
 
+import Cardano.Network.ConsensusMode (ConsensusMode (..))
+import Cardano.Network.Types (LedgerStateJudgement (..))
 import Ouroboros.Network.AnchoredFragment (AnchoredFragment)
 import Ouroboros.Network.Block
-import Ouroboros.Network.ConsensusMode (ConsensusMode (..))
-import Ouroboros.Network.PeerSelection.LedgerPeers.Type
-           (LedgerStateJudgement (..))
 import Ouroboros.Network.SizeInBytes (SizeInBytes)
 
 data PraosFetchMode =

ouroboros-network-api/src/Ouroboros/Network/PeerSelection/LedgerPeers/Type.hs

@@ -18,13 +18,12 @@ module Ouroboros.Network.PeerSelection.LedgerPeers.Type
   ( PoolStake (..)
   , AccPoolStake (..)
   , IsBigLedgerPeer (..)
-  , LedgerStateJudgement (..)
   , LedgerPeersConsensusInterface (..)
+  , mapExtraAPI
   , UseLedgerPeers (..)
   , AfterSlot (..)
   , LedgerPeersKind (..)
   , LedgerPeerSnapshot (.., LedgerPeerSnapshot)
-  , MinBigLedgerPeersForTrustedState (..)
   , isLedgerPeersEnabled
   , compareLedgerPeerSnapshotApproximate
   ) where
@@ -46,19 +45,6 @@ import Data.Aeson.Types
 import NoThunks.Class
 import Ouroboros.Network.PeerSelection.RelayAccessPoint
 
--- | Minimum number of hot big ledger peers in Genesis mode
---   for trusted state to be signalled to Consensus. This number
---   should be smaller than the `targetNumberOfActiveBigLedgerPeers`
---   but greater than 1. In Genesis, we may demote a big ledger peer
---   for underperformance, but not promote a replacement immediately
---   to guard against adversaries which may want to slow down our
---   progress.
---
-newtype MinBigLedgerPeersForTrustedState =
-  MinBigLedgerPeersForTrustedState { getMinBigLedgerPeersForTrustedState :: Int }
-  deriving stock (Eq, Show)
-  deriving newtype (FromJSON)
-
 -- |The type of big ledger peers that is serialised or later
 -- provided by node configuration for the networking layer
 -- to connect to when syncing.
@@ -237,18 +223,19 @@ data IsBigLedgerPeer
    | IsNotBigLedgerPeer
   deriving Eq
 
--- | Wether the node is caught up or fell too far behind the chain
-data LedgerStateJudgement = YoungEnough | TooOld
-  deriving (Eq, Show, Generic, NoThunks)
-
 -- | Return ledger state information and ledger peers.
 --
-data LedgerPeersConsensusInterface m = LedgerPeersConsensusInterface {
-    lpGetLatestSlot           :: STM m (WithOrigin SlotNo),
-    lpGetLedgerStateJudgement :: STM m LedgerStateJudgement,
-    lpGetLedgerPeers          :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]
+data LedgerPeersConsensusInterface extraAPI m = LedgerPeersConsensusInterface {
+    lpGetLatestSlot  :: STM m (WithOrigin SlotNo)
+  , lpGetLedgerPeers :: STM m [(PoolStake, NonEmpty RelayAccessPoint)]
+    -- | Extension point so that third party users can add more actions
+  , lpExtraAPI       :: extraAPI
   }
 
+mapExtraAPI :: (a -> b) -> LedgerPeersConsensusInterface a m -> LedgerPeersConsensusInterface b m
+mapExtraAPI f lpci@LedgerPeersConsensusInterface{ lpExtraAPI = api } =
+  lpci { lpExtraAPI = f api }
+
 instance ToJSON RelayAccessPointCoded where
   toJSON (RelayAccessPointCoded (RelayAccessDomain domain port)) =
     object