assistant: XMPP git pull and push requests are cached and sent when presence of a new client is detected.

Noticed that, At startup or network reconnect, git push messages were sent,
often before presence info has been gathered, so were not sent to any
buddies.

To fix this, keep track of which buddies have seen such messages,
and when new presence is received from a buddy that has not yet seen it,
resend.

This is done only for push initiation messages, so very little data needs
to be stored.
This commit is contained in:
Joey Hess 2013-03-06 21:33:08 -04:00
parent d76e281de0
commit c16adc25c4
5 changed files with 106 additions and 20 deletions

View file

@ -15,6 +15,7 @@ import Control.Concurrent.STM
import Control.Concurrent.MSampleVar
import Data.ByteString (ByteString)
import qualified Data.Set as S
import qualified Data.Map as M
{- Messages that can be sent out of band by a network messager. -}
data NetMessage
@ -47,6 +48,18 @@ data PushStage
| ReceivePackDone ExitCode
deriving (Show, Eq, Ord)
{- NetMessages that are important (and small), and should be stored to be
- resent when new clients are seen. -}
isImportantNetMessage :: NetMessage -> Maybe ClientID
isImportantNetMessage (Pushing c CanPush) = Just c
isImportantNetMessage (Pushing c PushRequest) = Just c
isImportantNetMessage _ = Nothing
readdressNetMessage :: NetMessage -> ClientID -> NetMessage
readdressNetMessage (PairingNotification stage _ uuid) c = PairingNotification stage c uuid
readdressNetMessage (Pushing _ stage) c = Pushing c stage
readdressNetMessage m _ = m
{- Things that initiate either side of a push, but do not actually send data. -}
isPushInitiation :: PushStage -> Bool
isPushInitiation CanPush = True
@ -81,6 +94,10 @@ getSide side m = m side
data NetMessager = NetMessager
-- outgoing messages
{ netMessages :: TChan (NetMessage)
-- important messages for each client
, importantNetMessages :: TMVar (M.Map ClientID (S.Set NetMessage))
-- important messages that are believed to have been sent to a client
, sentImportantNetMessages :: TMVar (M.Map ClientID (S.Set NetMessage))
-- write to this to restart the net messager
, netMessagerRestart :: MSampleVar ()
-- only one side of a push can be running at a time
@ -94,8 +111,9 @@ data NetMessager = NetMessager
newNetMessager :: IO NetMessager
newNetMessager = NetMessager
<$> atomically newTChan
<*> atomically (newTMVar M.empty)
<*> atomically (newTMVar M.empty)
<*> newEmptySV
<*> mkSideMap (newTMVar Nothing)
<*> mkSideMap newTChan
<*> mkSideMap (newTMVar S.empty)
where