Network: notify services when peer identity updates

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