ObjectDiffusion v2 (just inbound side changes) for efficient vote retrieval

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Network/NodeToNode.hs

@@ -70,8 +70,8 @@ import Ouroboros.Consensus.MiniProtocol.ChainSync.Client
   )
 import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client as CsClient
 import Ouroboros.Consensus.MiniProtocol.ChainSync.Server
-import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound (objectDiffusionInbound)
-import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1 (objectDiffusionInbound)
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1.State
   ( ObjectDiffusionInboundStateView
   , bracketObjectDiffusionInbound
   )

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/Node/GSM/PeerState.hs

@@ -17,7 +17,7 @@ import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.State
   , ChainSyncClientHandleCollection (..)
   , ChainSyncState (..)
   )
-import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1.State
   ( ObjectDiffusionInboundHandle (..)
   , ObjectDiffusionInboundHandleCollection (..)
   , ObjectDiffusionInboundState (..)

ouroboros-consensus-diffusion/src/ouroboros-consensus-diffusion/Ouroboros/Consensus/NodeKernel.hs

@@ -82,7 +82,7 @@ import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.HistoricityCheck
 import Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck
   ( SomeHeaderInFutureCheck
   )
-import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1.State
   ( ObjectDiffusionInboundHandleCollection (..)
   , newObjectDiffusionInboundHandleCollection
   )

ouroboros-consensus/bench/ObjectDiffusion-bench/Main.hs

@@ -0,0 +1,84 @@
+{-# LANGUAGE DeriveAnyClass #-}
+{-# LANGUAGE DeriveGeneric #-}
+{-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE NumericUnderscores #-}
+{-# LANGUAGE TypeApplications #-}
+
+-- | This module contains benchmarks for Peras Object diffusion decision logic
+-- as implemented by the by the function
+-- 'Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.Decision.makeDecision'
+module Main (main) where
+
+import Control.DeepSeq (NFData (..))
+import Control.Exception (evaluate)
+import Data.Hashable (Hashable)
+import GHC.Generics (Generic)
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.Decision qualified as OD
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.TestUtils qualified as OD
+import Test.QuickCheck (Arbitrary (..), generate)
+import Test.QuickCheck.Gen (vectorOf)
+import Test.Tasty.Bench
+
+-- TODO: We will probably want to use the actual types used in vote/cert diffusion,
+-- instead of placeholders.
+newtype DummyPeerAddr = DummyPeerAddr Int
+  deriving (Eq, Ord, Generic, NFData)
+
+instance Arbitrary DummyPeerAddr where
+  arbitrary = DummyPeerAddr <$> arbitrary
+
+newtype DummyObjectId = DummyObjectId Int
+  deriving (Eq, Ord, Generic, Hashable, NFData)
+
+instance Arbitrary DummyObjectId where
+  arbitrary = DummyObjectId <$> arbitrary
+
+data DummyObject = DummyObject
+  { doId :: DummyObjectId
+  , doPayload :: ()
+  }
+  deriving (Eq, Ord, Generic, Hashable, NFData)
+
+instance Arbitrary DummyObject where
+  arbitrary = DummyObject <$> arbitrary <*> arbitrary
+
+-- TODO: We should probably use specific policies that are well suited to the
+-- number of peers and objects.
+
+main :: IO ()
+main =
+  defaultMain
+    [ bgroup
+        "ouroboros-consensus:ObjectDiffusion"
+        [ bgroup
+            "VoteDiffusion"
+            [ env
+                (genToNF $ vectorOf 1_000 $ OD.genDecisionContext 10 50 doId Nothing)
+                ( \contexts ->
+                    bench "makeDecisions: 1000 decisions with (10 pairs, 50 objects) each" $
+                      nf (fmap makeVoteDiffusionDecisions) contexts
+                )
+            , env
+                (genToNF $ vectorOf 1_000 $ OD.genDecisionContext 100 500 doId Nothing)
+                ( \contexts ->
+                    bench "makeDecisions: 1000 decisions with (100 pairs, 500 objects) each" $
+                      nf (fmap makeVoteDiffusionDecisions) contexts
+                )
+            , env
+                (genToNF $ vectorOf 1_000 $ OD.genDecisionContext 1_000 5_000 doId Nothing)
+                ( \contexts ->
+                    bench "makeDecisions: 1000 decisions with (1000 pairs, 5000 objects) each" $
+                      nf (fmap makeVoteDiffusionDecisions) contexts
+                )
+            ]
+        , bgroup "CertDiffusion" []
+        ]
+    ]
+ where
+  genToNF gen = do
+    x <- generate gen
+    evaluate $ rnf x
+    pure $! x
+
+  makeVoteDiffusionDecisions decisionContext =
+    OD.makeDecisions @DummyPeerAddr @DummyObjectId @DummyObject decisionContext

ouroboros-consensus/ouroboros-consensus.cabal

@@ -191,8 +191,14 @@ library
     Ouroboros.Consensus.MiniProtocol.LocalStateQuery.Server
     Ouroboros.Consensus.MiniProtocol.LocalTxMonitor.Server
     Ouroboros.Consensus.MiniProtocol.LocalTxSubmission.Server
-    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
-    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1.State
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.Decision
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.Registry
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.State
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.TestUtils
+    Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V2.Types
     Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API
     Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.PerasCert
     Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Outbound
@@ -318,6 +324,7 @@ library
 
   build-depends:
     FailT ^>=0.1.2,
+    QuickCheck,
     aeson,
     base >=4.14 && <4.22,
     base-deriving-via,
@@ -354,6 +361,8 @@ library
     primitive,
     psqueues ^>=0.2.3,
     quiet ^>=0.2,
+    random,
+    random-shuffle,
     rawlock ^>=0.1.1,
     resource-registry ^>=0.1,
     semialign >=1.1,
@@ -928,6 +937,20 @@ benchmark PerasCertDB-bench
     tasty-bench,
     unstable-consensus-testlib,
 
+benchmark ObjectDiffusion-bench
+  import: common-bench
+  type: exitcode-stdio-1.0
+  hs-source-dirs: bench/ObjectDiffusion-bench
+  main-is: Main.hs
+  other-modules:
+  build-depends:
+    QuickCheck,
+    base,
+    deepseq,
+    hashable,
+    ouroboros-consensus,
+    tasty-bench,
+
 test-suite doctest
   import: common-test
   main-is: doctest.hs

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/Inbound.hs → ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/Inbound/V1.hs

@@ -11,7 +11,7 @@
 {-# LANGUAGE RecordWildCards #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound
+module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1
   ( objectDiffusionInbound
   , TraceObjectDiffusionInbound (..)
   , ObjectDiffusionInboundError (..)
@@ -38,7 +38,7 @@ import Data.Word (Word64)
 import GHC.Generics (Generic)
 import Network.TypedProtocol.Core (N (Z), Nat (..), natToInt)
 import NoThunks.Class (NoThunks (..))
-import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1.State
   ( ObjectDiffusionInboundStateView (..)
   )
 import Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.ObjectPool.API

ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/Inbound/State.hs → ouroboros-consensus/src/ouroboros-consensus/Ouroboros/Consensus/MiniProtocol/ObjectDiffusion/Inbound/V1/State.hs

@@ -6,7 +6,7 @@
 {-# LANGUAGE StandaloneDeriving #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.State
+module Ouroboros.Consensus.MiniProtocol.ObjectDiffusion.Inbound.V1.State
   ( ObjectDiffusionInboundState (..)
   , initObjectDiffusionInboundState
   , ObjectDiffusionInboundHandle (..)