diff --git a/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs b/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs index 55d7d641..8206f346 100644 --- a/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs +++ b/hbs2-core/lib/HBS2/Net/Proto/Event/PeerExpired.hs @@ -3,6 +3,7 @@ module HBS2.Net.Proto.Event.PeerExpired where import HBS2.Clock import HBS2.Events import HBS2.Net.Proto +import HBS2.Net.Proto.Peer import HBS2.Prelude.Plated data PeerExpires = PeerExpires @@ -12,7 +13,7 @@ data instance EventKey e PeerExpires = deriving stock (Typeable, Eq, Generic) data instance Event e PeerExpires = - PeerExpiredEvent (Peer e) + PeerExpiredEvent (Peer e) (Maybe (PeerData e)) deriving stock (Typeable) instance EventType (Event e PeerExpires) where diff --git a/hbs2-peer/app/PeerInfo.hs b/hbs2-peer/app/PeerInfo.hs index 813bb5d0..0c7d7fae 100644 --- a/hbs2-peer/app/PeerInfo.hs +++ b/hbs2-peer/app/PeerInfo.hs @@ -219,10 +219,11 @@ peerPingLoop cfg penv = do let l = realToFrac (toNanoSecs $ now - seen) / 1e9 -- FIXME: time-hardcode when ( l > 300 ) do + mpeerData <- find (KnownPeerKey p) id delPeers pl [p] expire (PeerInfoKey p) expire (KnownPeerKey p) - emit PeerExpiredEventKey (PeerExpiredEvent @e p) + emit PeerExpiredEventKey (PeerExpiredEvent @e p mpeerData) liftIO $ mapM_ link [watch, infoLoop]