Refactored DiffusionArguments for new root peers configuration (#3079)

* Added FromJSON/ToJSON instances

Fixed toJSON/fromJSON instance of PeerAdvertise

Added JSON roundtrip quickcheck tests

Fixed ToJSON/FromJSON instance of DomainAddress and RelayAddress

* Updated ouroboros-consensus to accomodate new DiffusionArguments type signature

Removed daStaticLocalRootPeers since RelayAddresses are used everywhere

Removed redundant imports

* Switched to Seq data type instead of list to simplify the code and use a
data structure with better asymptotics. In the end we end up converting
from/to List to respect the existing Diffusion Layer and
PeerSelectionActions APIs

* Changed daLocalRootPeersVar, daPublicRootPeersVar and
daUseLedgerAfterSlotVar to STM actions since they are read-only

Refactored RelayAddress Arbitrary instance definition

ouroboros-consensus/src/Ouroboros/Consensus/Node.hs

@@ -605,7 +605,7 @@ stdVersionDataNTC networkMagic = NodeToClientVersionData
 
 stdRunDataDiffusion ::
      DiffusionTracers
-  -> DiffusionArguments
+  -> DiffusionArguments IO
   -> DiffusionApplications
        RemoteAddress LocalAddress
        NodeToNodeVersionData NodeToClientVersionData
@@ -624,7 +624,7 @@ data StdRunNodeArgs m blk = StdRunNodeArgs
     -- ^ If @True@, validate the ChainDB on init no matter what
   , srnDatabasePath                :: FilePath
     -- ^ Location of the DBs
-  , srnDiffusionArguments          :: DiffusionArguments
+  , srnDiffusionArguments          :: DiffusionArguments m
   , srnDiffusionTracers            :: DiffusionTracers
   , srnEnableInDevelopmentVersions :: Bool
     -- ^ If @False@, then the node will limit the negotiated NTN and NTC

ouroboros-network/ouroboros-network.cabal

@@ -147,6 +147,7 @@ library
                        TypeFamilies,
                        TypeInType
   build-depends:       base              >=4.9 && <4.15,
+                       aeson,
                        async             >=2.2 && <2.3,
                        base16-bytestring,
                        bytestring        >=0.10 && <0.11,
@@ -268,6 +269,7 @@ test-suite test
                        Test.Ouroboros.Network.PeerSelection
                        Test.Ouroboros.Network.PeerSelection.Instances
                        Test.Ouroboros.Network.PeerSelection.LocalRootPeers
+                       Test.Ouroboros.Network.PeerSelection.Json
                        Test.Ouroboros.Network.PeerSelection.MockEnvironment
                        Test.Ouroboros.Network.PeerSelection.PeerGraph
                        Test.Ouroboros.Network.PeerSelection.Script
@@ -283,6 +285,7 @@ test-suite test
   default-language:    Haskell2010
   build-depends:       base,
                        QuickCheck,
+                       aeson,
                        array,
                        async,
                        binary,

ouroboros-network/src/Ouroboros/Network/Diffusion.hs

@@ -50,7 +50,7 @@ import           Control.Tracer (Tracer, nullTracer, traceWith)
 import           Data.Foldable (asum)
 import           Data.List.NonEmpty (NonEmpty (..))
 import qualified Data.List.NonEmpty as NonEmpty
-import qualified Data.Map as Map
+import           Data.Map (Map)
 import           Data.Maybe (catMaybes, maybeToList)
 import           Data.Set (Set)
 import           Data.Void (Void)
@@ -89,12 +89,13 @@ import           Ouroboros.Network.ConnectionHandler
 import           Ouroboros.Network.RethrowPolicy
 import qualified Ouroboros.Network.Diffusion.Policies as Diffusion.Policies
 import           Ouroboros.Network.IOManager
-import           Ouroboros.Network.PeerSelection.RootPeersDNS ( DomainAddress
-                                                              , resolveDomainAddresses
-                                                              , RelayAddress (..)
-                                                              )
 import           Ouroboros.Network.InboundGovernor (InboundGovernorTrace (..))
 import           Ouroboros.Network.InboundGovernor.State (InboundGovernorCounters (..))
+import           Ouroboros.Network.PeerSelection.RootPeersDNS ( resolveDomainAddresses
+                                                              , RelayAddress(..)
+                                                              , TraceLocalRootPeers(..)
+                                                              , TracePublicRootPeers(..)
+                                                              )
 import qualified Ouroboros.Network.PeerSelection.Governor as Governor
 import           Ouroboros.Network.PeerSelection.Governor.Types ( TracePeerSelection (..)
                                                                 , DebugPeerSelection (..)
@@ -134,9 +135,6 @@ import           Ouroboros.Network.NodeToNode ( ConnectionId (..)
                                               , nodeToNodeHandshakeCodec
                                               )
 import qualified Ouroboros.Network.NodeToNode   as NodeToNode
-import           Ouroboros.Network.PeerSelection.RootPeersDNS ( TraceLocalRootPeers (..)
-                                                              , TracePublicRootPeers (..)
-                                                              )
 
 
 -- TODO: use LocalAddress where appropriate rather than 'path'.
@@ -268,7 +266,7 @@ nullTracers = DiffusionTracers {
 
 -- | Network Node argumets
 --
-data DiffusionArguments = DiffusionArguments {
+data DiffusionArguments m = DiffusionArguments {
       daIPv4Address  :: Maybe (Either Socket.Socket AddrInfo)
       -- ^ an @IPv4@ socket ready to accept connections or an @IPv4@ addresses
     , daIPv6Address  :: Maybe (Either Socket.Socket AddrInfo)
@@ -279,10 +277,9 @@ data DiffusionArguments = DiffusionArguments {
     , daPeerSelectionTargets :: PeerSelectionTargets
       -- ^ selection targets for the peer governor
 
-    , daStaticLocalRootPeers :: [(Socket.SockAddr, PeerAdvertise)]
-    , daLocalRootPeers       :: [(DomainAddress, PeerAdvertise)]
-    , daPublicRootPeers      :: [DomainAddress]
-    , daUseLedgerAfter       :: UseLedgerAfter
+    , daReadLocalRootPeers  :: STM m [(Int, Map RelayAddress PeerAdvertise)]
+    , daReadPublicRootPeers :: STM m [RelayAddress]
+    , daReadUseLedgerAfter  :: STM m UseLedgerAfter
 
     , daAcceptedConnectionsLimit :: AcceptedConnectionsLimit
       -- ^ parameters for limiting number of accepted connections
@@ -570,7 +567,7 @@ type NodeToNodePeerSelectionActions (mode :: MuxMode) a =
 --
 runDataDiffusion
     :: DiffusionTracers
-    -> DiffusionArguments
+    -> DiffusionArguments IO
     -> DiffusionApplications
          RemoteAddress LocalAddress
          NodeToNodeVersionData NodeToClientVersionData
@@ -581,10 +578,9 @@ runDataDiffusion tracers
                                     , daIPv6Address
                                     , daLocalAddress
                                     , daPeerSelectionTargets
-                                    , daStaticLocalRootPeers
-                                    , daLocalRootPeers
-                                    , daPublicRootPeers
-                                    , daUseLedgerAfter
+                                    , daReadLocalRootPeers
+                                    , daReadPublicRootPeers
+                                    , daReadUseLedgerAfter
                                     , daAcceptedConnectionsLimit
                                     , daDiffusionMode
                                     , daProtocolIdleTimeout
@@ -668,15 +664,6 @@ runDataDiffusion tracers
         targetNumberOfActivePeers = min 2 (targetNumberOfActivePeers daPeerSelectionTargets)
       }
 
-    daLocalRootPeersVar <- newTVarIO $
-                            ([( 1
-                              , Map.fromList $
-                                  map (\(d,p) -> (RelayDomain d, p))
-                                      daLocalRootPeers)])
-    -- ^ TODO: This is just a simple transformation
-    daPublicRootPeersVar <- newTVarIO $ map RelayDomain daPublicRootPeers
-    daUseLedgerAfterVar <- newTVarIO daUseLedgerAfter
-
     let -- snocket for remote communication.
         snocket :: SocketSnocket
         snocket = Snocket.socketSnocket iocp
@@ -769,7 +756,7 @@ runDataDiffusion tracers
             (runLedgerPeers
               ledgerPeersRng
               dtLedgerPeersTracer
-              daUseLedgerAfterVar
+              daReadUseLedgerAfter
               daLedgerPeersCtx
               (resolveDomainAddresses
                 dtTracePublicRootPeersTracer
@@ -855,9 +842,8 @@ runDataDiffusion tracers
                       dtTracePublicRootPeersTracer
                       timeout
                       (readTVar peerSelectionTargetsVar)
-                      (Map.fromList daStaticLocalRootPeers)
-                      daLocalRootPeersVar
-                      daPublicRootPeersVar
+                      daReadLocalRootPeers
+                      daReadPublicRootPeers
                       peerStateActions
                       (putTMVar ledgerPeersReq)
                       (takeTMVar ledgerPeersRsp)
@@ -966,9 +952,8 @@ runDataDiffusion tracers
                       dtTracePublicRootPeersTracer
                       timeout
                       (readTVar peerSelectionTargetsVar)
-                      (Map.fromList daStaticLocalRootPeers)
-                      daLocalRootPeersVar
-                      daPublicRootPeersVar
+                      daReadLocalRootPeers
+                      daReadPublicRootPeers
                       peerStateActions
                       (putTMVar ledgerPeersReq)
                       (takeTMVar ledgerPeersRsp)

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

@@ -203,19 +203,19 @@ runLedgerPeers :: forall m.
                       )
                => StdGen
                -> Tracer m TraceLedgerPeers
-               -> StrictTVar m UseLedgerAfter
+               -> STM m UseLedgerAfter
                -> LedgerPeersConsensusInterface m
                -> ([DomainAddress] -> m (Map DomainAddress (Set SockAddr)))
                -> STM m NumberOfPeers
                -> (Maybe (Set SockAddr, DiffTime) -> STM m ())
                -> m Void
-runLedgerPeers inRng tracer useLedgerAfterVar LedgerPeersConsensusInterface{..} doResolve
+runLedgerPeers inRng tracer readUseLedgerAfter LedgerPeersConsensusInterface{..} doResolve
                getReq putRsp = do
     go inRng (Time 0) Map.empty
   where
     go :: StdGen -> Time -> Map AccPoolStake (PoolStake, NonEmpty RelayAddress) -> m Void
     go rng oldTs peerMap = do
-        useLedgerAfter <- atomically $ readTVar useLedgerAfterVar
+        useLedgerAfter <- atomically readUseLedgerAfter
         traceWith tracer (TraceUseLedgerAfter useLedgerAfter)
 
         let peerListLifeTime = if Map.null peerMap && isLedgerPeersEnabled useLedgerAfter