From f857c44b4540025e29206fd90a8856dc9d21c6a4 Mon Sep 17 00:00:00 2001 From: Joey Hess Date: Sun, 26 May 2013 17:09:23 -0400 Subject: [PATCH] avoid redundant CanPush messages with different shas being queued up --- Assistant/NetMessager.hs | 8 +++++--- 1 file changed, 5 insertions(+), 3 deletions(-) diff --git a/Assistant/NetMessager.hs b/Assistant/NetMessager.hs index 7c996bb098..7738e44b09 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