diff --git a/hbs2-core/lib/HBS2/Defaults.hs b/hbs2-core/lib/HBS2/Defaults.hs index 31aa459b..6a03421d 100644 --- a/hbs2-core/lib/HBS2/Defaults.hs +++ b/hbs2-core/lib/HBS2/Defaults.hs @@ -51,7 +51,7 @@ defRequestLimit :: TimeSpec defRequestLimit = toTimeSpec defRequestLimitSec defBlockSizeCacheTime :: TimeSpec -defBlockSizeCacheTime = toTimeSpec ( 20 :: Timeout 'Seconds ) +defBlockSizeCacheTime = toTimeSpec ( 30 :: Timeout 'Seconds ) defRequestLimitSec :: Timeout 'Seconds defRequestLimitSec = 60 @@ -60,7 +60,7 @@ defBlockBanTime :: TimeSpec defBlockBanTime = toTimeSpec defBlockBanTimeSec defBlockBanTimeSec :: Timeout 'Seconds -defBlockBanTimeSec = 60 :: Timeout 'Seconds +defBlockBanTimeSec = 30 :: Timeout 'Seconds defBlockWipTimeout :: TimeSpec defBlockWipTimeout = defCookieTimeout diff --git a/hbs2-peer/app/BlockDownload.hs b/hbs2-peer/app/BlockDownload.hs index 447d80d3..47d0f1f2 100644 --- a/hbs2-peer/app/BlockDownload.hs +++ b/hbs2-peer/app/BlockDownload.hs @@ -59,7 +59,9 @@ withBlockForDownload p action = do -- FIXME: busyloop-e46ad5e0 h <- getBlockForDownload banned <- isBanned p h + trace $ "withBlockForDownload" <+> pretty p <+> pretty h if banned then do + trace $ "skip banned block" <+> pretty p <+> pretty h addDownload h else do action h @@ -525,6 +527,12 @@ postponedLoop :: forall e m . ( MyPeer e postponedLoop env0 = do e <- ask + void $ liftIO $ async $ withPeerM e $ withDownload env0 do + forever do + pause @'Seconds 10 + mt <- asks (view downloadQ) >>= liftIO . atomically . isEmptyTQueue + debug $ "queue monitor thread" <+> "EMPTY:" <+> pretty mt + void $ liftIO $ async $ withPeerM e $ withDownload env0 do -- wip <- asks (blockWip) >>= liftIO . Cache.keys wip0 <- asks (view blockWip) >>= liftIO . Cache.keys <&> length @@ -534,15 +542,16 @@ postponedLoop env0 = do pause @'Seconds 10 wip1 <- asks (view blockWip) >>= liftIO . Cache.keys wip2 <- liftIO $ readTVarIO twip - trace $ "download stuck chech" <+> pretty wip1 <+> pretty wip2 + trace $ "download stuck check" <+> pretty (length wip1) <+> pretty wip2 - when (length wip1 == wip2) do - trace "download stuck" + when (length wip1 == wip2 && not (null wip1)) do + debug "download stuck" for_ wip1 $ \h -> do removeFromWip h addDownload h - wip3 <- asks (view blockWip) >>= liftIO . Cache.keys - liftIO $ atomically $ writeTVar twip (length wip3) + + wip3 <- asks (view blockWip) >>= liftIO . Cache.keys + liftIO $ atomically $ writeTVar twip (length wip3) void $ liftIO $ async $ withPeerM e $ withDownload env0 do forever do @@ -660,14 +669,16 @@ peerDownloadLoop peer = do writeTVar downFail 0 modifyTVar downBlk succ - fix \next -> do + forever do auth' <- lift $ find (KnownPeerKey peer) id pinfo' <- lift $ find (PeerInfoKey peer) id -- (view peerDownloadFail) let mbauth = (,) <$> auth' <*> pinfo' - maybe1 mbauth none $ \(_,pinfo) -> do + let noAuth = warn ( "lost peer auth" <+> pretty peer) >> pause @'Seconds 5 + + maybe1 mbauth noAuth $ \(_,pinfo) -> do withBlockForDownload peer $ \h -> do -- TODO: insert-busyloop-counter-for-block-request @@ -697,15 +708,17 @@ peerDownloadLoop peer = do Right Nothing -> do -- FIXME: non-existent-block-ruins-all - liftIO $ Cache.insert noBlock h () + here <- liftIO $ Cache.lookup noBlock h <&> isJust + + unless here $ + liftIO $ Cache.insert noBlock h () + addDownload h Right (Just s) -> do updateBlockPeerSize h peer s tryDownload pinfo h s - next - -- NOTE: this is an adapter for a ResponseM monad -- because response is working in ResponseM monad (ha!) -- So don't be confused with types diff --git a/hbs2-peer/app/PeerInfo.hs b/hbs2-peer/app/PeerInfo.hs index dd909db1..07f55a56 100644 --- a/hbs2-peer/app/PeerInfo.hs +++ b/hbs2-peer/app/PeerInfo.hs @@ -73,9 +73,9 @@ newtype instance SessionKey e (PeerInfo e) = deriving newtype instance Hashable (SessionKey UDP (PeerInfo UDP)) deriving stock instance Eq (SessionKey UDP (PeerInfo UDP)) +-- FIXME: this? instance Expires (SessionKey UDP (PeerInfo UDP)) where - expiresIn = const (Just 600) - + expiresIn = const (Just defCookieTimeoutSec) pexLoop :: forall e m . ( HasPeerLocator e m , HasPeer e @@ -115,6 +115,7 @@ peerPingLoop :: forall e m . ( HasPeerLocator e m , Sessions e (PeerInfo e) m , Sessions e (KnownPeer e) m , EventListener e (PeerExchangePeersEv e) m + , EventListener e (PeerHandshake e) m , Pretty (Peer e) , MonadIO m ) @@ -123,12 +124,15 @@ peerPingLoop = do wake <- liftIO newTQueueIO + pause @'Seconds 0.25 + subscribe @e PeerExchangePeersKey $ \(PeerExchangePeersData sas) -> do liftIO $ atomically $ writeTQueue wake sas - forever do + subscribe @e AnyKnownPeerEventKey $ \(KnownPeerEvent p _) -> do + liftIO $ atomically $ writeTQueue wake [p] - pause @'Seconds 1 + forever do -- FIXME: defaults r <- liftIO $ race (pause @'Seconds 60) diff --git a/hbs2-peer/app/PeerTypes.hs b/hbs2-peer/app/PeerTypes.hs index 6650fc4a..4681a9f9 100644 --- a/hbs2-peer/app/PeerTypes.hs +++ b/hbs2-peer/app/PeerTypes.hs @@ -383,6 +383,7 @@ failedDownload :: forall e m . ( MyPeer e -> BlockDownloadM e m () failedDownload p h = do + trace $ "failedDownload" <+> pretty p <+> pretty h addDownload h updateBlockPeerSize :: forall e m . (MyPeer e, MonadIO m)