From fbed52c9210e010f0385917bc03d02f19b375e8d Mon Sep 17 00:00:00 2001 From: Sergey Ivanov Date: Mon, 15 May 2023 01:53:48 +0400 Subject: [PATCH] wip --- hbs2-core/lib/HBS2/Net/Messaging/TCP.hs | 3 +-- hbs2-core/lib/HBS2/Net/PeerLocator.hs | 2 -- hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs | 6 ----- hbs2-core/lib/HBS2/Net/Proto/PeerExchange.hs | 1 - hbs2-peer/app/BlockHttpDownload.hs | 25 +++++++++++++------- hbs2-peer/app/PeerMain.hs | 2 +- hbs2-peer/app/PeerTypes.hs | 2 -- 7 files changed, 18 insertions(+), 23 deletions(-) diff --git a/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs b/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs index 05bb68af..60d15a40 100644 --- a/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs +++ b/hbs2-core/lib/HBS2/Net/Messaging/TCP.hs @@ -4,6 +4,7 @@ module HBS2.Net.Messaging.TCP , runMessagingTCP , newMessagingTCP , tcpOwnPeer + , tcpPeerConn , tcpCookie ) where @@ -202,8 +203,6 @@ spawnConnection tp env so sa = liftIO do let newP = fromSockAddr @'TCP sa theirCookie <- handshake tp env so - -- TCP address available - -- FIXME: how to use this info let connId = connectionId myCookie theirCookie diff --git a/hbs2-core/lib/HBS2/Net/PeerLocator.hs b/hbs2-core/lib/HBS2/Net/PeerLocator.hs index e64ccf1e..ab6182f0 100644 --- a/hbs2-core/lib/HBS2/Net/PeerLocator.hs +++ b/hbs2-core/lib/HBS2/Net/PeerLocator.hs @@ -8,7 +8,6 @@ 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] @@ -18,7 +17,6 @@ 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 diff --git a/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs b/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs index 22cf5920..c96939db 100644 --- a/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs +++ b/hbs2-core/lib/HBS2/Net/PeerLocator/Static.hs @@ -33,12 +33,6 @@ 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)) diff --git a/hbs2-core/lib/HBS2/Net/Proto/PeerExchange.hs b/hbs2-core/lib/HBS2/Net/Proto/PeerExchange.hs index 267884d3..60d3a5fd 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/PeerExchange.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/PeerExchange.hs @@ -105,7 +105,6 @@ peerExchangeProto msg = do pl <- getPeerLocator @e pips <- knownPeers @e pl - -- pips <- knownListeningPeers @e pl case pex of PEX1 -> do diff --git a/hbs2-peer/app/BlockHttpDownload.hs b/hbs2-peer/app/BlockHttpDownload.hs index fcc8423a..88c0056d 100644 --- a/hbs2-peer/app/BlockHttpDownload.hs +++ b/hbs2-peer/app/BlockHttpDownload.hs @@ -12,6 +12,7 @@ import HBS2.Events import HBS2.Hash import HBS2.Merkle import HBS2.Net.IP.Addr +import HBS2.Net.Messaging.TCP import HBS2.Net.PeerLocator import HBS2.Net.Proto import HBS2.Net.Proto.Definition @@ -153,8 +154,8 @@ fillPeerMeta :: forall e m . , EventListener e ( PeerMetaProto e) m , e ~ L4Proto ) - => m () -fillPeerMeta = do + => Maybe MessagingTCP -> m () +fillPeerMeta mtcp = do debug "I'm fillPeerMeta" pl <- getPeerLocator @e forever do @@ -200,13 +201,19 @@ fillPeerMeta = do -- 3) пробить, что есть tcp forM_ (lookupDecode "listen-tcp" (unPeerMeta peerMeta)) \listenTCPPort -> lift do peerTCPAddrPort <- replacePort p listenTCPPort - -- 4) выяснить, можно ли к нему открыть соединение на этот порт - -- возможно, с ним уже открыто соединение - -- или попробовать открыть или запомнить, что было открыто - -- connectPeerTCP ? - -- 5) добавить этих пиров в пекс - -- p :: Peer e <- fromPeerAddr (L4Address TCP (peerTCPAddrPort :: IPAddrPort L4Proto) :: PeerAddr e) - sendPing =<< fromPeerAddr (L4Address TCP peerTCPAddrPort) + p <- fromPeerAddr (L4Address TCP peerTCPAddrPort) + sendPing p + + forM_ mtcp \(tcp :: MessagingTCP) -> do + -- 4) выяснить, можно ли к нему открыть соединение на этот порт + -- возможно, с ним уже открыто соединение + -- или попробовать открыть или запомнить, что было открыто + -- connectPeerTCP ? + tcpAddressIsAvailable <- isJust <$> do + liftIO $ atomically $ readTVar (view tcpPeerConn tcp) <&> HashMap.lookup p + when tcpAddressIsAvailable do + -- добавить этого пира в pex + addPeers pl [p] port <- (MaybeT . pure) (lookupDecode "http-port" (unPeerMeta peerMeta)) diff --git a/hbs2-peer/app/PeerMain.hs b/hbs2-peer/app/PeerMain.hs index cfd60914..43bbb4a5 100644 --- a/hbs2-peer/app/PeerMain.hs +++ b/hbs2-peer/app/PeerMain.hs @@ -743,7 +743,7 @@ runPeer opts = Exception.handle myException $ do peerThread "blockDownloadLoop " (blockDownloadLoop denv) - peerThread "fillPeerMeta" (fillPeerMeta) + peerThread "fillPeerMeta" (fillPeerMeta tcp) -- FIXME: clumsy-code -- Is it better now ? diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs index 08180ac3..9aa36b5a 100644 --- a/hbs2-peer/app/PeerTypes.hs +++ b/hbs2-peer/app/PeerTypes.hs @@ -65,7 +65,6 @@ data PeerInfo e = , _peerHttpApiAddress :: TVar (Either Int (Maybe String)) , _peerHttpDownloaded :: TVar Int , _peerMeta :: TVar (Maybe PeerMeta) - , _peerTcpAvailable :: TVar Bool } deriving stock (Generic,Typeable) @@ -90,7 +89,6 @@ newPeerInfo = liftIO do <*> newTVarIO (Left 0) <*> newTVarIO 0 <*> newTVarIO Nothing - <*> newTVarIO False type instance SessionData e (PeerInfo e) = PeerInfo e