wip

hbs2-core/lib/HBS2/Net/PeerLocator.hs

@@ -8,6 +8,7 @@ import System.Random.Shuffle (shuffleM)
 
 class PeerLocator e l where
   knownPeers   :: forall m . (HasPeer e, MonadIO m) => l -> m [Peer e]
+  -- knownListeningPeers   :: forall m . (HasPeer e, MonadIO m) => l -> m [Peer e]
   addPeers     :: forall m . (HasPeer e, MonadIO m) => l -> [Peer e] -> m ()
   delPeers     :: forall m . (HasPeer e, MonadIO m) => l -> [Peer e] -> m ()
   bestPeers    :: forall m . (HasPeer e, MonadIO m) => l -> m [Peer e]
@@ -17,6 +18,7 @@ data AnyPeerLocator e = forall a . PeerLocator e a => AnyPeerLocator a
 
 instance HasPeer e => PeerLocator e (AnyPeerLocator e) where
   knownPeers (AnyPeerLocator l) = knownPeers  l
+  -- knownListeningPeers (AnyPeerLocator l) = knownListeningPeers  l
   addPeers (AnyPeerLocator l) = addPeers l
   delPeers (AnyPeerLocator l) = delPeers l
   addExcluded (AnyPeerLocator l) = addExcluded l

hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs

@@ -33,6 +33,12 @@ instance (Ord (Peer e), Pretty (Peer e)) => PeerLocator  e (StaticPeerLocator e)
     excl <- liftIO $ readTVarIO e
     pure $ Set.toList (ps `Set.difference` excl)
 
+  -- knownListeningPeers (StaticPeerLocator peers e) = do
+  --   -- pips <- knownPeers @e pl >>= filterM (liftIO . atomically . readTVar . _peerTcpAvailable)
+  --   ps <- liftIO $ readTVarIO  peers
+  --   excl <- liftIO $ readTVarIO e
+  --   pure $ Set.toList (ps `Set.difference` excl)
+
   addPeers (StaticPeerLocator peers te) new = do
     excl <- liftIO $ readTVarIO te
     liftIO $ atomically $ modifyTVar' peers ((`Set.difference` excl) . (<> Set.fromList new))

hbs2-core/lib/HBS2/Net/Proto/PeerExchange.hs

@@ -105,6 +105,7 @@ peerExchangeProto msg = do
 
       pl   <- getPeerLocator @e
       pips <- knownPeers @e pl
+      -- pips <- knownListeningPeers @e pl
 
       case pex of
         PEX1 -> do

hbs2-peer/app/BlockDownload.hs

@@ -594,7 +594,7 @@ postponedLoop env0 = do
       -- for_ (w:ws) $ addDownload mzero
       next
 
-  void $ liftIO $ async $ withPeerM e $ withDownload env0 do
+  void $ liftIO $ withPeerM e $ withDownload env0 do
     forever do
       pause @'Seconds 30
       trace "UNPOSTPONE LOOP"

hbs2-peer/app/PeerMain.hs

@@ -750,7 +750,7 @@ runPeer opts = Exception.handle myException $ do
                 when useHttpDownload do
                   peerThread "blockHttpDownloadLoop " (blockHttpDownloadLoop denv)
 
-                -- peerThread "postponedLoop" (postponedLoop denv)
+                peerThread "postponedLoop" (postponedLoop denv)
 
                 peerThread "downloadQueue" (downloadQueue conf denv)
 

hbs2-peer/app/PeerTypes.hs

@@ -65,6 +65,7 @@ data PeerInfo e =
   , _peerHttpApiAddress :: TVar (Either Int (Maybe String))
   , _peerHttpDownloaded :: TVar Int
   , _peerMeta           :: TVar (Maybe PeerMeta)
+  , _peerTcpAvailable   :: TVar Bool
   }
   deriving stock (Generic,Typeable)
 
@@ -89,6 +90,7 @@ newPeerInfo = liftIO do
            <*> newTVarIO (Left 0)
            <*> newTVarIO 0
            <*> newTVarIO Nothing
+           <*> newTVarIO False
 
 type instance SessionData e (PeerInfo e) = PeerInfo e