Added P2PDecisionType and Refactored requestPublicRootPeers type

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Testnet/Cardano/Simulation.hs

@@ -150,16 +150,11 @@ import Ouroboros.Cardano.PeerSelection.PeerSelectionActions
 import Ouroboros.Network.BlockFetch (FetchMode (..), PraosFetchMode (..),
            TraceFetchClientState, TraceLabelPeer (..))
 import Ouroboros.Network.Diffusion.Common qualified as Common
-import Ouroboros.Network.PeerSelection.Governor.Types
-           (BootstrapPeersCriticalTimeoutError)
 import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
 import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint (..),
            PortNumber, RelayAccessPoint (..))
-import Ouroboros.Network.PeerSelection.RootPeersDNS (PeerActionsDNS (..))
 import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSLookupType)
-import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSSemaphore
-           (newLedgerAndPublicRootDNSSemaphore)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers
            (TraceLocalRootPeers)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers
@@ -1116,19 +1111,8 @@ diffusionSimulation
       onlyOutboundConnectionsStateVar <- newTVarIO UntrustedState
       useBootstrapPeersScriptVar <- newTVarIO bootstrapPeers
       churnModeVar <- newTVarIO ChurnModeNormal
-      dnsSemaphore <- newLedgerAndPublicRootDNSSemaphore
-      dnsTimeoutScriptVar <- newTVarIO dnsTimeout
-      dnsLookupDelayScriptVar <- newTVarIO dnsLookupDelay
-
-      let dnsActions :: PeerActionsDNS (TestAddress NtNAddr_) () BootstrapPeersCriticalTimeoutError m
-          dnsActions =
-            PeerActionsDNS {
-              paToPeerAddr = (\a b -> TestAddress (IPAddr a b))
-            , paDnsActions = mockDNSActions dMapVar
-                                            dnsTimeoutScriptVar
-                                            dnsLookupDelayScriptVar
-            }
-          readUseBootstrapPeers = stepScriptSTM' useBootstrapPeersScriptVar
+
+      let readUseBootstrapPeers = stepScriptSTM' useBootstrapPeersScriptVar
           (bgaRng, rng) = Random.split $ mkStdGen seed
           acceptedConnectionsLimit =
             AcceptedConnectionsLimit maxBound maxBound 0
@@ -1285,10 +1269,7 @@ diffusionSimulation
             requestPublicRootPeers (Common.dtTracePublicRootPeersTracer tracersExtraAddr)
                                    (caeReadUseBootstrapPeers cardanoExtraArgs)
                                    (pure TooOld)
-                                   (\a b -> TestAddress (IPAddr a b))
-                                   dnsSemaphore
                                    readPublicRootPeers
-                                   (paDnsActions dnsActions)
 
       run blockGeneratorArgs
                      limitsAndTimeouts
@@ -1298,7 +1279,7 @@ diffusionSimulation
                      (cardanoExtraArgsToPeerSelectionActions cardanoExtraArgs)
                      CPSV.empty
                      CPRP.cardanoPublicRootPeersAPI
-                     (cardanoPeerSelectionGovernorArgs readUseLedgerPeers peerSharing (iLedgerPeersConsensusInterface interfaces))
+                     (cardanoPeerSelectionGovernorArgs readUseLedgerPeers peerSharing (clpciUpdateOutboundConnectionsState $ lpExtraAPI $ iLedgerPeersConsensusInterface interfaces))
                      CPSV.cardanoPeerSelectionStatetoCounters
                      requestPublicRootPeers'
                      peerChurnGovernor

ouroboros-network/sim-tests-lib/Test/Ouroboros/Network/Diffusion/Testnet/Minimal/Node.hs

@@ -106,7 +106,9 @@ import Ouroboros.Network.PeerSelection.PeerStateActions (PeerConnectionHandle)
 import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
 import Ouroboros.Network.PeerSelection.RelayAccessPoint (DomainAccessPoint,
            RelayAccessPoint)
+import Ouroboros.Network.PeerSelection.RootPeersDNS (PeerActionsDNS)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSLookupType)
+import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSSemaphore (DNSSemaphore)
 import Ouroboros.Network.PeerSelection.State.LocalRootPeers (HotValency,
            LocalRootConfig, WarmValency)
 import Ouroboros.Network.PeerSelection.Types (PublicExtraPeersAPI (..))
@@ -170,7 +172,7 @@ type ResolverException = SomeException
 
 run :: forall extraArgs extraState extraDebugState extraActions extraAPI
              extraPeers extraFlags extraChurnArgs extraCounters
-             exception resolver m.
+             exception resolver resolverError m.
        ( Alternative (STM m)
        , MonadAsync       m
        , MonadDelay       m
@@ -193,6 +195,7 @@ run :: forall extraArgs extraState extraDebugState extraActions extraAPI
        , Exception exception
 
        , resolver ~ ()
+       , resolverError ~ ResolverException
        , forall a. Semigroup a => Semigroup (m a)
        )
     => Node.BlockGeneratorArgs Block StdGen
@@ -226,7 +229,9 @@ run :: forall extraArgs extraState extraDebugState extraActions extraAPI
           (PeerConnectionHandle
              muxMode responderCtx NtNAddr ntnVersionData bytes m a b)
         -> extraCounters)
-    -> ( (NumberOfPeers -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
+    -> (   PeerActionsDNS NtNAddr resolver resolverError m
+        -> DNSSemaphore m
+        -> (NumberOfPeers -> LedgerPeersKind -> m (Maybe (Set NtNAddr, DiffTime)))
         -> LedgerPeersKind
         -> Int
         -> m (PublicRootPeers extraPeers NtNAddr, DiffTime))
@@ -453,7 +458,7 @@ run blockGeneratorArgs limits ni na
                    extraArgs extraState extraDebugState extraActions
                    extraAPI extraPeers extraFlags
                    extraChurnArgs extraCounters exception
-                   NtNAddr m
+                   NtNAddr resolver resolverError m
     argsExtra = Common.ArgumentsExtra
       { Common.daPeerSelectionTargets   = aPeerTargets na
       , Common.daReadLocalRootPeers     = aReadLocalRootPeers na

ouroboros-network/src/Ouroboros/Cardano/Network/PeerSelection/Governor/Types.hs

@@ -32,8 +32,7 @@ import Ouroboros.Network.PeerSelection.Governor.Types (AssociationMode (..),
            BootstrapPeersCriticalTimeoutError (..), ExtraGuardedDecisions (..),
            PeerSelectionGovernorArgs (..), PeerSelectionSetsWithSizes,
            PeerSelectionState (..), PeerSelectionView (..))
-import Ouroboros.Network.PeerSelection.LedgerPeers.Type
-           (LedgerPeersConsensusInterface (..), UseLedgerPeers)
+import Ouroboros.Network.PeerSelection.LedgerPeers.Type (UseLedgerPeers)
 import Ouroboros.Network.PeerSelection.PeerSharing (PeerSharing)
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
 import Ouroboros.Network.PeerSelection.State.EstablishedPeers qualified as EstablishedPeers
@@ -185,7 +184,7 @@ cardanoPeerSelectionGovernorArgs
      )
   => STM m UseLedgerPeers
   -> PeerSharing
-  -> LedgerPeersConsensusInterface (CardanoLedgerPeersConsensusInterface m) m
+  -> (OutboundConnectionsState -> STM m ())
   -> PeerSelectionGovernorArgs
        CardanoPeerSelectionState
        extraDebugState
@@ -198,7 +197,7 @@ cardanoPeerSelectionGovernorArgs
        peerconn
        BootstrapPeersCriticalTimeoutError
        m
-cardanoPeerSelectionGovernorArgs readUseLedgerPeers peerSharing lpsci =
+cardanoPeerSelectionGovernorArgs readUseLedgerPeers peerSharing updateOutboundConnectionsState =
   PeerSelectionGovernorArgs {
     -- If by any chance the node takes more than 15 minutes to converge to a
     -- clean state, we crash the node. This could happen in very rare
@@ -215,7 +214,7 @@ cardanoPeerSelectionGovernorArgs readUseLedgerPeers peerSharing lpsci =
       associationMode <- readAssociationMode readUseLedgerPeers
                                              peerSharing
                                              (cpstBootstrapPeersFlag (extraState st))
-      clpciUpdateOutboundConnectionsState (lpExtraAPI lpsci)
+      updateOutboundConnectionsState
         (outboundConnectionsState associationMode psv st)
   , extraDecisions  =
       ExtraGuardedDecisions {

ouroboros-network/src/Ouroboros/Cardano/PeerSelection/PeerSelectionActions.hs

@@ -24,14 +24,13 @@ import Data.Map qualified as Map
 import Data.Set (Set)
 import Data.Set qualified as Set
 import Network.DNS qualified as DNS
-import Network.Socket (PortNumber)
 import Ouroboros.Cardano.Network.PublicRootPeers (CardanoPublicRootPeers (..))
 import Ouroboros.Network.PeerSelection.LedgerPeers hiding (getLedgerPeers)
 import Ouroboros.Network.PeerSelection.PeerAdvertise (PeerAdvertise (..))
 import Ouroboros.Network.PeerSelection.PeerSelectionActions (getPublicRootPeers)
 import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
 import Ouroboros.Network.PeerSelection.PublicRootPeers qualified as PublicRootPeers
-import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSActions)
+import Ouroboros.Network.PeerSelection.RootPeersDNS (PeerActionsDNS (..))
 import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSSemaphore (DNSSemaphore)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers
 
@@ -48,17 +47,20 @@ requestPublicRootPeers
   => Tracer m TracePublicRootPeers
   -> STM m UseBootstrapPeers
   -> STM m LedgerStateJudgement
-  -> (IP -> PortNumber -> peeraddr)
-  -> DNSSemaphore m
   -> STM m (Map RelayAccessPoint PeerAdvertise)
-  -> DNSActions resolver exception m
+  -> PeerActionsDNS peeraddr resolver exception m
+  -> DNSSemaphore m
   -> (NumberOfPeers -> LedgerPeersKind -> m (Maybe (Set peeraddr, DiffTime)))
   -> LedgerPeersKind
   -> Int
   -> m (PublicRootPeers (CardanoPublicRootPeers peeraddr) peeraddr, DiffTime)
 requestPublicRootPeers
-  publicTracer useBootstrapped getLedgerStateJudgement
-  toPeerAddr dnsSemaphore readPublicRootPeers dnsActions
+  publicTracer useBootstrapped
+  getLedgerStateJudgement readPublicRootPeers
+  PeerActionsDNS { paToPeerAddr = toPeerAddr
+                 , paDnsActions = dnsActions
+                 }
+  dnsSemaphore
   getLedgerPeers ledgerPeersKind n = do
   -- Check if the node is in a sensitive state
   usingBootstrapPeers <- atomically

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

@@ -7,6 +7,7 @@
 module Ouroboros.Network.Diffusion
   ( -- * Common API
     P2P (..)
+  , P2PDecision (..)
   , ExtraTracers (..)
   , ArgumentsExtra (..)
   , Applications (..)
@@ -18,6 +19,7 @@ module Ouroboros.Network.Diffusion
 import Control.Concurrent.Class.MonadSTM.Strict (StrictTVar)
 import Control.Exception (Exception, IOException)
 import Data.Functor (void)
+import Network.DNS (Resolver)
 import Network.Socket (Socket)
 import Ouroboros.Network.Diffusion.Common (Arguments,
            NodeToNodeConnectionManager, NodeToNodePeerConnectionHandle, Tracers)
@@ -37,6 +39,16 @@ data P2P = P2P        -- ^ General P2P mode. Can be instantiated with custom
                       -- data types
          | NonP2P     -- ^ Cardano non-P2P mode. Deprecated
 
+-- | Auxiliary type to define arbitrary decision types based on type level
+-- P2P
+--
+data P2PDecision (p2p :: P2P) a b where
+  P2PDecision :: a
+              -> P2PDecision 'P2P a b
+  NonP2PDecision :: b
+              -> P2PDecision 'NonP2P a b
+
+
 -- | Tracers which depend on p2p mode.
 --
 data ExtraTracers (p2p :: P2P) extraState extraDebugState extraFlags extraPeers extraCounters m where
@@ -57,20 +69,20 @@ data ExtraTracers (p2p :: P2P) extraState extraDebugState extraFlags extraPeers
 --
 data ArgumentsExtra
        (p2p :: P2P) extraArgs extraState extraDebugState extraActions extraAPI
-       extraPeers extraFlags extraChurnArgs extraCounters exception ntnAddr m where
+       extraPeers extraFlags extraChurnArgs extraCounters exception ntnAddr resolver resolverError m where
   P2PArguments
     :: Common.ArgumentsExtra extraArgs extraState extraDebugState extraActions extraAPI
                             extraPeers extraFlags extraChurnArgs
-                            extraCounters exception ntnAddr m
+                            extraCounters exception ntnAddr resolver resolverError m
     -> ArgumentsExtra 'P2P extraArgs extraState extraDebugState extraActions extraAPI
                            extraPeers extraFlags extraChurnArgs
-                           extraCounters exception ntnAddr m
+                           extraCounters exception ntnAddr resolver resolverError m
 
   NonP2PArguments
     :: NonP2P.ArgumentsExtra
     -> ArgumentsExtra 'NonP2P extraArgs extraState extraDebugState extraActions extraAPI
                               extraPeers extraFlags extraChurnArgs
-                              extraCounters exception ntnAddr m
+                              extraCounters exception ntnAddr resolver resolverError m
 
 -- | Application data which depend on p2p mode.
 --
@@ -133,7 +145,7 @@ run :: forall (p2p :: P2P) extraArgs extraState extraDebugState extraActions ext
          LocalSocket LocalAddress
     -> ArgumentsExtra p2p extraArgs extraState extraDebugState extraActions extraAPI
        extraPeers extraFlags extraChurnArgs extraCounters exception
-       RemoteAddress IO
+       RemoteAddress Resolver IOException IO
     -> Applications p2p RemoteAddress LocalAddress NodeToNodeVersionData NodeToClientVersionData extraAPI IO a
     -> ApplicationsExtra p2p RemoteAddress IO a
     -> IO ()

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

@@ -82,8 +82,10 @@ import Ouroboros.Network.PeerSelection.PeerStateActions (PeerConnectionHandle,
            PeerSelectionActionsTrace (..))
 import Ouroboros.Network.PeerSelection.PublicRootPeers (PublicRootPeers)
 import Ouroboros.Network.PeerSelection.RelayAccessPoint (RelayAccessPoint)
+import Ouroboros.Network.PeerSelection.RootPeersDNS (PeerActionsDNS)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSActions (DNSActions,
            DNSLookupType (..))
+import Ouroboros.Network.PeerSelection.RootPeersDNS.DNSSemaphore (DNSSemaphore)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.LocalRootPeers
            (TraceLocalRootPeers)
 import Ouroboros.Network.PeerSelection.RootPeersDNS.PublicRootPeers
@@ -359,7 +361,7 @@ nullTracersExtra =
 --
 data ArgumentsExtra extraArgs extraState extraDebugState extraActions extraAPI extraPeers
                     extraFlags extraChurnArgs extraCounters exception
-                    peeraddr m = ArgumentsExtra {
+                    peeraddr resolver resolverError m = ArgumentsExtra {
       -- | selection targets for the peer governor
       --
       daPeerSelectionTargets   :: PeerSelectionTargets
@@ -450,7 +452,9 @@ data ArgumentsExtra extraArgs extraState extraDebugState extraActions extraAPI e
       -- 'Ouroboros.Network.PeerSelection.PeerSelectionActions.getPublicRootPeers'
       --
     , daRequestPublicRootPeers
-        :: ( (NumberOfPeers -> LedgerPeersKind -> m (Maybe (Set peeraddr, DiffTime)))
+        :: PeerActionsDNS peeraddr resolver resolverError m
+        -> DNSSemaphore m
+        -> ( (NumberOfPeers -> LedgerPeersKind -> m (Maybe (Set peeraddr, DiffTime)))
         -> LedgerPeersKind
         -> Int
         -> m (PublicRootPeers extraPeers peeraddr, DiffTime))

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

@@ -95,6 +95,7 @@ import Ouroboros.Network.PeerSelection.State.LocalRootPeers qualified as LocalRo
 import Ouroboros.Network.PeerSharing (PeerSharingRegistry (..))
 import Ouroboros.Network.RethrowPolicy
 import Ouroboros.Network.Server2 qualified as Server
+import Network.DNS (Resolver)
 
 runM
     :: forall m ntnFd ntnAddr ntnVersion ntnVersionData
@@ -155,7 +156,7 @@ runM
     -> -- | p2p configuration
        ArgumentsExtra extraArgs extraState extraDebugState extraActions extraAPI
                       extraPeers extraFlags extraChurnArgs extraCounters
-                      exception ntnAddr m
+                      exception ntnAddr resolver resolverError m
 
     -> -- | protocol handlers
        Applications ntnAddr ntnVersion ntnVersionData
@@ -637,7 +638,7 @@ runM Interfaces
                                          peerConnToPeerSharing      = pchPeerSharing diNtnPeerSharing,
                                          requestPeerShare           =
                                            getPeerShare (readTVar (getPeerSharingRegistry daPeerSharingRegistry)),
-                                         requestPublicRootPeers     = daRequestPublicRootPeers getLedgerPeers,
+                                         requestPublicRootPeers     = daRequestPublicRootPeers dnsActions dnsSemaphore getLedgerPeers,
                                          readInboundPeers =
                                            case daOwnPeerSharing of
                                              PeerSharingDisabled -> pure Map.empty
@@ -856,6 +857,8 @@ run :: ( Monoid extraPeers
         extraCounters
         exception
         RemoteAddress
+        Resolver
+        IOException
         IO
     -> Applications
         RemoteAddress