reconnect XMPP when NetWatcher notices a change

This commit is contained in:
Joey Hess 2012-10-27 00:42:14 -04:00
parent 9fc8257392
commit 2dc40ecbd1
6 changed files with 58 additions and 19 deletions

View file

@ -11,6 +11,7 @@ import Common.Annex
import Utility.TSet
import Control.Concurrent.STM
import Control.Concurrent.MSampleVar
import Data.Time.Clock
import qualified Data.Map as M
@ -18,8 +19,13 @@ import qualified Data.Map as M
type PushMap = M.Map Remote UTCTime
type FailedPushMap = TMVar PushMap
{- Used to notify about successful pushes. -}
newtype PushNotifier = PushNotifier (TSet UUID)
{- The TSet is recent, successful pushes that other remotes should be
- notified about.
-
- The MSampleVar is written to when the PushNotifier thread should be
- restarted for some reason.
-}
data PushNotifier = PushNotifier (TSet UUID) (MSampleVar ())
{- The TMVar starts empty, and is left empty when there are no
- failed pushes. This way we can block until there are some failed pushes.
@ -50,10 +56,18 @@ changeFailedPushMap v a = atomically $
| otherwise = putTMVar v $! m
newPushNotifier :: IO PushNotifier
newPushNotifier = PushNotifier <$> newTSet
newPushNotifier = PushNotifier
<$> newTSet
<*> newEmptySV
notifyPush :: [UUID] -> PushNotifier -> IO ()
notifyPush us (PushNotifier s) = putTSet s us
notifyPush us (PushNotifier s _) = putTSet s us
waitPush :: PushNotifier -> IO [UUID]
waitPush (PushNotifier s) = getTSet s
waitPush (PushNotifier s _) = getTSet s
notifyRestart :: PushNotifier -> IO ()
notifyRestart (PushNotifier _ sv) = writeSV sv ()
waitRestart :: PushNotifier -> IO ()
waitRestart (PushNotifier _ sv) = readSV sv