p2p-governor: localRootPersProvider

Return 'Void', but accept only a non-empty list.  This fits better with
all other 'Void's in 'Diffusion'.

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

@@ -37,9 +37,10 @@ import qualified Data.Set as Set
 import           Data.Set (Set)
 import qualified Data.Map.Strict as Map
 import           Data.Map.Strict (Map)
+import           Data.Void (Void)
 
 import           Control.Exception (IOException)
-import           Control.Monad (when, unless)
+import           Control.Monad (when)
 import           Control.Monad.Class.MonadAsync
 import           Control.Monad.Class.MonadSTM.Strict
 import           Control.Monad.Class.MonadTime
@@ -278,31 +279,27 @@ data TraceLocalRootPeers =
 
 -- |
 --
--- This action typically runs indefinitely, but can terminate successfully in
--- corner cases where there is nothing to do.
---
 localRootPeersProvider :: Tracer IO TraceLocalRootPeers
                        -> TimeoutFn IO
                        -> DNS.ResolvConf
                        -> StrictTVar IO (Map DomainAddress (Map Socket.SockAddr PeerAdvertise))
-                       -> [(DomainAddress, PeerAdvertise)]
-                       -> IO ()
+                       -> NonEmpty (DomainAddress, PeerAdvertise)
+                       -> IO Void
 localRootPeersProvider tracer timeout resolvConf rootPeersVar domains = do
-    traceWith tracer (TraceLocalRootDomains domains)
-    unless (null domains) $ do
+    traceWith tracer (TraceLocalRootDomains (NonEmpty.toList domains))
 #if !defined(mingw32_HOST_OS)
-      rr <- asyncResolverResource resolvConf
+    rr <- asyncResolverResource resolvConf
 #else
-      let rr = newResolverResource resolvConf
+    let rr = newResolverResource resolvConf
 #endif
-      withAsyncAll (map (monitorDomain rr) domains) $ \asyncs ->
-        waitAny asyncs >> return ()
+    withAsyncAll (map (monitorDomain rr) (NonEmpty.toList domains)) $ \asyncs ->
+      snd <$> waitAny asyncs
   where
-    monitorDomain :: Resource DNSorIOError DNS.Resolver -> (DomainAddress, PeerAdvertise) -> IO ()
+    monitorDomain :: Resource DNSorIOError DNS.Resolver -> (DomainAddress, PeerAdvertise) -> IO Void
     monitorDomain rr0 (domain@DomainAddress {daDomain, daPortNumber}, advertisePeer) =
         go rr0 0
       where
-        go :: Resource DNSorIOError DNS.Resolver -> DiffTime -> IO ()
+        go :: Resource DNSorIOError DNS.Resolver -> DiffTime -> IO Void
         go !rr !ttl = do
           when (ttl > 0) $ do
             traceWith tracer (TraceLocalRootWaiting domain ttl)

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

@@ -16,9 +16,11 @@ import           Control.Monad.Class.MonadTime
 import           Control.Monad.Class.MonadSTM.Strict
 import           Control.Tracer (Tracer)
 
+import           Data.List.NonEmpty (NonEmpty (..))
 import           Data.Map (Map)
 import qualified Data.Map as Map
 import           Data.Set (Set)
+import           Data.Void (Void)
 
 import qualified Network.DNS as DNS
 import qualified Network.Socket as Socket
@@ -32,6 +34,7 @@ import           Ouroboros.Network.PeerSelection.RootPeersDNS
 withPeerSelectionActions
   :: Tracer IO TraceLocalRootPeers
   -> Tracer IO TracePublicRootPeers
+  -> TimeoutFn IO
   -> PeerSelectionTargets
   -> Map Socket.SockAddr PeerAdvertise
   -- ^ static local root peers
@@ -40,35 +43,37 @@ withPeerSelectionActions
   -> [DomainAddress]
   -- ^ public root peers
   -> PeerStateActions Socket.SockAddr peerconn IO
-  -> (Async IO () -> PeerSelectionActions Socket.SockAddr peerconn IO -> IO a)
-  -- ^ continuation, which allows to tra
+  -> (Maybe (Async IO Void) -> PeerSelectionActions Socket.SockAddr peerconn IO -> IO a)
+  -- ^ continuation, recieves a handle to the local roots peer provider thread
+  -- (only if local root peers where non-empty).
   -> IO a
-withPeerSelectionActions localRootTracer publicRootTracer targets staticLocalRootPeers localRootPeers publicRootPeers peerStateActions k = do
+withPeerSelectionActions localRootTracer publicRootTracer timeout targets staticLocalRootPeers localRootPeers publicRootPeers peerStateActions k = do
     localRootsVar <- newTVarIO Map.empty
-    withTimeoutSerial $ \timeout ->
-      withAsync
-        (localRootPeersProvider
-          localRootTracer
-          timeout
-          DNS.defaultResolvConf
-          localRootsVar
-          localRootPeers)
-        $ \thread ->
-          k thread
-            PeerSelectionActions {
-                readPeerSelectionTargets = pure targets,
-                readLocalRootPeers = do
-                  localRoots <- readTVar localRootsVar
-                  pure (foldr Map.union staticLocalRootPeers localRoots),
-                requestPublicRootPeers = requestPublicRootPeers timeout,
-                requestPeerGossip = \_ -> pure [],
-                peerStateActions
-              }
+    let peerSelectionActions = PeerSelectionActions {
+            readPeerSelectionTargets = pure targets,
+            readLocalRootPeers = do
+              localRoots <- readTVar localRootsVar
+              pure (foldr Map.union staticLocalRootPeers localRoots),
+            requestPublicRootPeers,
+            requestPeerGossip = \_ -> pure [],
+            peerStateActions
+          }
+    case localRootPeers of
+      []       -> k Nothing peerSelectionActions
+      (a : as) ->
+        withAsync
+          (localRootPeersProvider
+            localRootTracer
+            timeout
+            DNS.defaultResolvConf
+            localRootsVar
+            (a :| as))
+          (\thread -> k (Just thread) peerSelectionActions)
   where
     -- For each call we re-initialise the dns library which forces reading
     -- `/etc/resolv.conf`:
     -- https://github.com/input-output-hk/cardano-node/issues/731
-    requestPublicRootPeers :: TimeoutFn IO -> Int -> IO (Set Socket.SockAddr, DiffTime)
-    requestPublicRootPeers timeout n =
+    requestPublicRootPeers :: Int -> IO (Set Socket.SockAddr, DiffTime)
+    requestPublicRootPeers n =
       publicRootPeersProvider publicRootTracer timeout DNS.defaultResolvConf publicRootPeers ($ n)