summaryrefslogtreecommitdiff
path: root/src/Network.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network.hs')
-rw-r--r--src/Network.hs16
1 files changed, 10 insertions, 6 deletions
diff --git a/src/Network.hs b/src/Network.hs
index 6fae8c5..da786c6 100644
--- a/src/Network.hs
+++ b/src/Network.hs
@@ -722,11 +722,7 @@ finalizedChannel peer self = do
-- Notify services about new peer
readTVar (peerIdentityVar peer) >>= \case
- PeerIdentityFull _ ->
- writeTQueue (serverIOActions $ peerServer peer) $ do
- forM_ (serverServices $ peerServer peer) $ \case
- service@(SomeService _ attrs) ->
- runPeerServiceOn (Just (service, attrs)) peer serviceNewPeer
+ PeerIdentityFull _ -> notifyServicesOfPeer peer
_ -> return ()
-- Outstanding service packets
@@ -754,7 +750,8 @@ handleIdentityAnnounce self peer ref = liftIO $ atomically $ do
PeerIdentityFull pid
| idData pid `precedes` wrappedLoad ref
- -> validateAndUpdate (idUpdates pid) $ \_ -> return ()
+ -> validateAndUpdate (idUpdates pid) $ \_ -> do
+ notifyServicesOfPeer peer
_ -> return ()
@@ -766,9 +763,16 @@ handleIdentityUpdate peer ref = liftIO $ atomically $ do
-> do
writeTVar (peerIdentityVar peer) $ PeerIdentityFull pid'
writeTChan (serverChanPeer $ peerServer peer) peer
+ when (idData pid /= idData pid') $ notifyServicesOfPeer peer
| otherwise -> return ()
+notifyServicesOfPeer :: Peer -> STM ()
+notifyServicesOfPeer peer@Peer { peerServer_ = Server {..} } = do
+ writeTQueue serverIOActions $ do
+ forM_ serverServices $ \service@(SomeService _ attrs) ->
+ runPeerServiceOn (Just (service, attrs)) peer serviceNewPeer
+
mkPeer :: Server -> PeerAddress -> IO Peer
mkPeer server paddr = do