wip

hbs2-core/lib/HBS2/Defaults.hs

@@ -42,7 +42,7 @@ defProtoPipelineSize :: Int
 defProtoPipelineSize = 65536*2
 
 defCookieTimeoutSec :: Timeout 'Seconds
-defCookieTimeoutSec = 3600
+defCookieTimeoutSec = 1200
 
 defCookieTimeout :: TimeSpec
 defCookieTimeout = toTimeSpec defCookieTimeoutSec

hbs2-peer/app/PeerInfo.hs

@@ -164,16 +164,21 @@ peerPingLoop cfg = do
 
     for_ pips $ \p -> do
       npi <- newPeerInfo
-      pfails <- fetch True npi (PeerInfoKey p) (view peerPingFailed)
-      pdownfails <- fetch True npi (PeerInfoKey p) (view peerDownloadFail)
+
+      here <- find @e (KnownPeerKey p) id
+
+      pinfo <- fetch True npi (PeerInfoKey p) id
+      let pfails = view peerPingFailed pinfo
+      let pdownfails = view peerDownloadFail pinfo
 
       liftIO $ atomically $ modifyTVar pfails succ
+
       sendPing @e p
 
       fnum <- liftIO $ readTVarIO pfails
       fdown <- liftIO $ readTVarIO pdownfails
 
-      when (fnum > 2) do -- FIXME: hardcode!
+      when (fnum > 4) do -- FIXME: hardcode!
         warn $ "removing peer" <+> pretty p <+> "for not responding to our pings"
         delPeers pl [p]
         expire (PeerInfoKey p)

hbs2-peer/app/PeerTypes.hs

@@ -372,15 +372,26 @@ delPeerThread p = do
 
   maybe1 pt (pure ()) $ liftIO . cancel . view peerThreadAsync
 
-newPeerThread :: (MyPeer e, MonadIO m) => Peer e -> Async () -> BlockDownloadM e m ()
+newPeerThread :: ( MyPeer e
+                 , MonadIO m
+                 , Sessions e (PeerInfo e) m
+                 -- , Sessions e (PeerInfo e) (BlockDownloadM e m)
+                 )
+              => Peer e
+              -> Async ()
+              -> BlockDownloadM e m ()
+
 newPeerThread p m = do
+
+  npi <- newPeerInfo
+  void $ lift $ fetch True npi (PeerInfoKey p) id
+
   q <- liftIO  newTQueueIO
   let pt = PeerThread m q
   threads <- asks (view peerThreads)
   liftIO $ atomically $ modifyTVar threads $ HashMap.insert p pt
 
 
-
 failedDownload :: forall e m . ( MyPeer e
                                , MonadIO m
                                , HasPeer e