emit PeerExpiredEventKey (PeerExpiredEvent @e p mpeerData)

This commit is contained in:
Sergey Ivanov 2023-07-18 19:56:39 +04:00
parent 563377c855
commit 5a8f1cef8b
2 changed files with 4 additions and 2 deletions

View File

@ -3,6 +3,7 @@ module HBS2.Net.Proto.Event.PeerExpired where
import HBS2.Clock import HBS2.Clock
import HBS2.Events import HBS2.Events
import HBS2.Net.Proto import HBS2.Net.Proto
import HBS2.Net.Proto.Peer
import HBS2.Prelude.Plated import HBS2.Prelude.Plated
data PeerExpires = PeerExpires data PeerExpires = PeerExpires
@ -12,7 +13,7 @@ data instance EventKey e PeerExpires =
deriving stock (Typeable, Eq, Generic) deriving stock (Typeable, Eq, Generic)
data instance Event e PeerExpires = data instance Event e PeerExpires =
PeerExpiredEvent (Peer e) PeerExpiredEvent (Peer e) (Maybe (PeerData e))
deriving stock (Typeable) deriving stock (Typeable)
instance EventType (Event e PeerExpires) where instance EventType (Event e PeerExpires) where

View File

@ -219,10 +219,11 @@ peerPingLoop cfg penv = do
let l = realToFrac (toNanoSecs $ now - seen) / 1e9 let l = realToFrac (toNanoSecs $ now - seen) / 1e9
-- FIXME: time-hardcode -- FIXME: time-hardcode
when ( l > 300 ) do when ( l > 300 ) do
mpeerData <- find (KnownPeerKey p) id
delPeers pl [p] delPeers pl [p]
expire (PeerInfoKey p) expire (PeerInfoKey p)
expire (KnownPeerKey p) expire (KnownPeerKey p)
emit PeerExpiredEventKey (PeerExpiredEvent @e p) emit PeerExpiredEventKey (PeerExpiredEvent @e p mpeerData)
liftIO $ mapM_ link [watch, infoLoop] liftIO $ mapM_ link [watch, infoLoop]