summaryrefslogtreecommitdiff
path: root/Assistant
diff options
context:
space:
mode:
authorGravatar Joey Hess <joey@kitenet.net>2013-05-26 17:09:23 -0400
committerGravatar Joey Hess <joey@kitenet.net>2013-05-26 17:09:23 -0400
commit797014d458f193ca223d420afaf0a6fb8281fe3b (patch)
treee2c874d7723df84047c476dd69d20ead1e4a9448 /Assistant
parent4a7c964986eb1404f2375b46db5705233c8f4832 (diff)
avoid redundant CanPush messages with different shas being queued up
Diffstat (limited to 'Assistant')
-rw-r--r--Assistant/NetMessager.hs8
1 files changed, 5 insertions, 3 deletions
diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs
index 7c996bb09..7738e44b0 100644
--- a/Assistant/NetMessager.hs
+++ b/Assistant/NetMessager.hs
@@ -32,8 +32,9 @@ notifyNetMessagerRestart =
waitNetMessagerRestart :: Assistant ()
waitNetMessagerRestart = readSV <<~ (netMessagerRestart . netMessager)
-{- Store an important NetMessage for a client, and if an equivilant
- - message was already sent, remove it from sentImportantNetMessages. -}
+{- Store a new important NetMessage for a client, and if an equivilant
+ - older message is already stored, remove it from both importantNetMessages
+ - and sentImportantNetMessages. -}
storeImportantNetMessage :: NetMessage -> ClientID -> (ClientID -> Bool) -> Assistant ()
storeImportantNetMessage m client matchingclient = go <<~ netMessager
where
@@ -41,7 +42,8 @@ storeImportantNetMessage m client matchingclient = go <<~ netMessager
q <- takeTMVar $ importantNetMessages nm
sent <- takeTMVar $ sentImportantNetMessages nm
putTMVar (importantNetMessages nm) $
- M.alter (Just . maybe (S.singleton m) (S.insert m)) client q
+ M.alter (Just . maybe (S.singleton m) (S.insert m)) client $
+ M.mapWithKey removematching sent q
putTMVar (sentImportantNetMessages nm) $
M.mapWithKey removematching sent
removematching someclient s