mirror of https://github.com/voidlizard/hbs2
emit PeerExpiredEventKey (PeerExpiredEvent @e p mpeerData)
This commit is contained in:
parent
563377c855
commit
5a8f1cef8b
|
@ -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
|
||||||
|
|
|
@ -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]
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue