diff options
| author |  Joey Hess <joey@kitenet.net> | 2012-10-24 15:42:02 -0400 |
|---|---|---|
| committer | Joey Hess <joey@kitenet.net> | 2012-10-24 15:42:02 -0400 |
| commit | e61eabc176e145deed2572efff3e1c22c0939b79 (patch) | |
| tree | 3f219e8abb3a320f4db66122aeadaab72c671218 /Assistant/Pushes.hs | |
| parent | 74bfce98180d93ac84fea5ca383d981d773e2e50 (diff) | |
initial implementation of XMPP push notifier (untested)
Lacking error handling, reconnection, credentials configuration,
and doesn't actually do anything when it receives an incoming notification.
Other than that, it might work! :)
Diffstat (limited to 'Assistant/Pushes.hs')
| -rw-r--r-- | Assistant/Pushes.hs | 14 |
1 files changed, 7 insertions, 7 deletions
diff --git a/Assistant/Pushes.hs b/Assistant/Pushes.hs index 649975fd1..7842c1884 100644 --- a/Assistant/Pushes.hs +++ b/Assistant/Pushes.hs @@ -8,9 +8,9 @@ module Assistant.Pushes where import Common.Annex +import Utility.TSet import Control.Concurrent.STM -import Control.Concurrent.MSampleVar import Data.Time.Clock import qualified Data.Map as M @@ -19,7 +19,7 @@ type PushMap = M.Map Remote UTCTime type FailedPushMap = TMVar PushMap {- Used to notify about successful pushes. -} -newtype PushNotifier = PushNotifier (MSampleVar ()) +newtype PushNotifier = PushNotifier (TSet UUID) {- 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 +50,10 @@ changeFailedPushMap v a = atomically $ | otherwise = putTMVar v $! m newPushNotifier :: IO PushNotifier -newPushNotifier = PushNotifier <$> newEmptySV +newPushNotifier = PushNotifier <$> newTSet -notifyPush :: PushNotifier -> IO () -notifyPush (PushNotifier sv) = writeSV sv () +notifyPush :: [UUID] -> PushNotifier -> IO () +notifyPush us (PushNotifier s) = putTSet s us -waitPush :: PushNotifier -> IO () -waitPush (PushNotifier sv) = readSV sv +waitPush :: PushNotifier -> IO [UUID] +waitPush (PushNotifier s) = getTSet s |