diff options
author | Joey Hess <joey@kitenet.net> | 2013-05-26 17:09:23 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-05-26 17:09:23 -0400 |
commit | 797014d458f193ca223d420afaf0a6fb8281fe3b (patch) | |
tree | e2c874d7723df84047c476dd69d20ead1e4a9448 /Assistant | |
parent | 4a7c964986eb1404f2375b46db5705233c8f4832 (diff) |
avoid redundant CanPush messages with different shas being queued up
Diffstat (limited to 'Assistant')
-rw-r--r-- | Assistant/NetMessager.hs | 8 |
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 |