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.

1 files changed, 19 insertions, 1 deletions

diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs
index c036d624a..55bf896bd 100644
--- a/Assistant/Types/NetMessager.hs
+++ b/Assistant/Types/NetMessager.hs
@@ -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