diff options
author | Joey Hess <joey@kitenet.net> | 2013-05-22 15:13:31 -0400 |
---|---|---|
committer | Joey Hess <joey@kitenet.net> | 2013-05-22 15:13:31 -0400 |
commit | 186434797dc41c815a07825072a63c9de1b47a25 (patch) | |
tree | 94ada4e3a7333a5e87557d5bc6ed51bb977f8e74 /Assistant/Types | |
parent | dcbb9c33d5e82beb32a1068924f467d968ce9611 (diff) |
add two long-running XMPP push threads, no more inversion of control
I hope this will be easier to reason about, and less buggy. It was
certianly easier to write!
An immediate benefit is that with a traversable queue of push requests to
select from, the threads can be a lot fairer about choosing which client to
service next.
Diffstat (limited to 'Assistant/Types')
-rw-r--r-- | Assistant/Types/NetMessager.hs | 23 |
1 files changed, 9 insertions, 14 deletions
diff --git a/Assistant/Types/NetMessager.hs b/Assistant/Types/NetMessager.hs index 525ff29f2..4b4e614a2 100644 --- a/Assistant/Types/NetMessager.hs +++ b/Assistant/Types/NetMessager.hs @@ -11,15 +11,15 @@ import Common.Annex import Assistant.Pairing import Git.Types +import qualified Data.Text as T +import qualified Data.Set as S +import qualified Data.Map as M +import qualified Data.DList as D import Control.Concurrent.STM import Control.Concurrent.MSampleVar import Data.ByteString (ByteString) import qualified Data.ByteString.Char8 as B8 import Data.Text (Text) -import qualified Data.Text as T -import qualified Data.Set as S -import qualified Data.Map as M -import qualified Data.DList as D {- Messages that can be sent out of band by a network messager. -} data NetMessage @@ -130,15 +130,11 @@ data NetMessager = NetMessager , 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 - -- the TMVars are empty when nothing is running - , netMessagerPushRunning :: SideMap (TMVar ClientID) - -- number of threads trying to push to the same client - -- at the same time (either running, or waiting to run) - , netMessagerPushThreadCount :: SideMap (TVar (M.Map ClientID Int)) - -- incoming messages containing data for a push, - -- on a per-client and per-side basis - , netMessagesInboxes :: SideMap Inboxes + -- queue of incoming messages that request the initiation of pushes + , netMessagerPushInitiations :: SideMap (TMVar [NetMessage]) + -- incoming messages containing data for a running + -- (or not yet started) push + , netMessagerInboxes :: SideMap Inboxes } newNetMessager :: IO NetMessager @@ -149,4 +145,3 @@ newNetMessager = NetMessager <*> newEmptySV <*> mkSideMap newEmptyTMVar <*> mkSideMap (newTVar M.empty) - <*> mkSideMap (newTVar M.empty) |