diff options
Diffstat (limited to 'src/Erebos')
| -rw-r--r-- | src/Erebos/DirectMessage.hs | 4 | ||||
| -rw-r--r-- | src/Erebos/Network.hs | 13 | ||||
| -rw-r--r-- | src/Erebos/Service.hs | 3 | ||||
| -rw-r--r-- | src/Erebos/Sync.hs | 1 |
4 files changed, 14 insertions, 7 deletions
diff --git a/src/Erebos/DirectMessage.hs b/src/Erebos/DirectMessage.hs index d680997..7807204 100644 --- a/src/Erebos/DirectMessage.hs +++ b/src/Erebos/DirectMessage.hs @@ -108,9 +108,11 @@ instance Service DirectMessage where else join $ asks $ dmOwnerMismatch . svcAttributes serviceNewPeer = do - updateDirectMessagePeer . finalOwner =<< asks svcPeerIdentity syncDirectMessageToPeer . lookupSharedValue . lsShared . fromStored =<< svcGetLocal + serviceUpdatedPeer = do + updateDirectMessagePeer . finalOwner =<< asks svcPeerIdentity + serviceStorageWatchers _ = [ SomeStorageWatcher (lookupSharedValue . lsShared . fromStored) syncDirectMessageToPeer , GlobalStorageWatcher (lookupSharedValue . lsShared . fromStored) findMissingPeers diff --git a/src/Erebos/Network.hs b/src/Erebos/Network.hs index f0c44a4..6265bbf 100644 --- a/src/Erebos/Network.hs +++ b/src/Erebos/Network.hs @@ -784,7 +784,7 @@ finalizedChannel peer@Peer {..} ch self = do -- Notify services about new peer readTVar peerIdentityVar >>= \case - PeerIdentityFull _ -> notifyServicesOfPeer peer + PeerIdentityFull _ -> notifyServicesOfPeer True peer _ -> return () @@ -810,7 +810,7 @@ handleIdentityAnnounce self peer ref = liftIO $ atomically $ do PeerIdentityFull pid | idData pid `precedes` wrappedLoad ref -> validateAndUpdate (idUpdates pid) $ \_ -> do - notifyServicesOfPeer peer + notifyServicesOfPeer False peer _ -> return () @@ -823,16 +823,17 @@ handleIdentityUpdate peer ref = liftIO $ atomically $ do writeTVar (peerIdentityVar peer) $ PeerIdentityFull pid' writeTChan (serverChanPeer $ peerServer peer) peer when (pid /= pid') $ do - notifyServicesOfPeer peer + notifyServicesOfPeer False peer | otherwise -> return () -notifyServicesOfPeer :: Peer -> STM () -notifyServicesOfPeer peer@Peer { peerServer_ = Server {..} } = do +notifyServicesOfPeer :: Bool -> Peer -> STM () +notifyServicesOfPeer new peer@Peer { peerServer_ = Server {..} } = do writeTQueue serverIOActions $ do paddr <- getPeerAddress peer forM_ serverServices $ \service@(SomeService _ attrs) -> - runPeerServiceOn (Just ( service, attrs )) [] paddr peer serviceNewPeer + runPeerServiceOn (Just ( service, attrs )) [] paddr peer $ + if new then serviceNewPeer else serviceUpdatedPeer receivedFromCustomAddress :: PeerAddressType addr => Server -> addr -> ByteString -> IO () diff --git a/src/Erebos/Service.hs b/src/Erebos/Service.hs index afcf512..303f9db 100644 --- a/src/Erebos/Service.hs +++ b/src/Erebos/Service.hs @@ -51,6 +51,9 @@ class ( serviceNewPeer :: ServiceHandler s () serviceNewPeer = return () + serviceUpdatedPeer :: ServiceHandler s () + serviceUpdatedPeer = return () + type ServiceAttributes s = attr | attr -> s type ServiceAttributes s = Proxy s defaultServiceAttributes :: proxy s -> ServiceAttributes s diff --git a/src/Erebos/Sync.hs b/src/Erebos/Sync.hs index d837a14..5f5fdec 100644 --- a/src/Erebos/Sync.hs +++ b/src/Erebos/Sync.hs @@ -31,6 +31,7 @@ instance Service SyncService where else return ls serviceNewPeer = notifyPeer . lsShared . fromStored =<< svcGetLocal + serviceUpdatedPeer = serviceNewPeer serviceStorageWatchers _ = (:[]) $ SomeStorageWatcher (lsShared . fromStored) notifyPeer instance Storable SyncService where |