reconnect XMPP when NetWatcher notices a change
This commit is contained in:
parent
9fc8257392
commit
2dc40ecbd1
6 changed files with 58 additions and 19 deletions
|
@ -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
|
||||
|
|
Loading…
Add table
Add a link
Reference in a new issue