e5bd-download-stuck-on-big-volumes

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

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,13 +542,14 @@ 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)
 
@@ -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
+                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

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)

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)