diff options
author | joe <joe@jerkface.net> | 2013-07-13 14:36:29 -0400 |
---|---|---|
committer | joe <joe@jerkface.net> | 2013-07-13 14:36:29 -0400 |
commit | e1180bc58ec6fe9b0195c55244c50cb96cb0423a (patch) | |
tree | 64a727284d83333bca1b6d3faa65f939d308fd34 /Presence | |
parent | 6cf176ef39ef6e9616c74cbfc7c728c18d066526 (diff) |
comments in main.hs, updated modules.svg
Diffstat (limited to 'Presence')
-rw-r--r-- | Presence/main.hs | 98 |
1 files changed, 68 insertions, 30 deletions
diff --git a/Presence/main.hs b/Presence/main.hs index 8c2371f4..cfc7154c 100644 --- a/Presence/main.hs +++ b/Presence/main.hs | |||
@@ -57,6 +57,74 @@ import Network.Socket (Family(AF_INET,AF_INET6)) | |||
57 | import Holumbus.Data.MultiMap as MM (MultiMap) | 57 | import Holumbus.Data.MultiMap as MM (MultiMap) |
58 | import qualified Holumbus.Data.MultiMap as MM | 58 | import qualified Holumbus.Data.MultiMap as MM |
59 | 59 | ||
60 | {- PresenceState | ||
61 | - | ||
62 | - This is the global state for the xmpp daemon. | ||
63 | - It is not directly accessed outside of this module. | ||
64 | -} | ||
65 | data PresenceState = PresenceState | ||
66 | { hostname :: Peer -- ByteString, TODO: remove this, its always LocalHost now | ||
67 | |||
68 | -- currentTTY - a string such as "tty7" which is kept up to date as console | ||
69 | -- switches occur. | ||
70 | , currentTTY :: TVar ByteString | ||
71 | |||
72 | -- activeUsers - a is a set of triples representing data in /var/run/utmp | ||
73 | -- it is kept up to date by an inotify watch on that file. | ||
74 | , activeUsers :: TVar (Set (UserName, Tty, ProcessID)) | ||
75 | |||
76 | -- subscriberMap - the idea was to allow subscribing to a particular user only. | ||
77 | -- When that user becomes present, an announcement would be sent | ||
78 | -- on the channel associated with him. This functionality is currently | ||
79 | -- unused and may be removed soon if it's decided its unneccessary. | ||
80 | , subscriberMap :: TVar (Map JID (RefCount,TChan Presence)) -- UNUSED as yet | ||
81 | |||
82 | -- localSubscriber - a channel and reference count where all presence events are | ||
83 | -- announced. | ||
84 | , localSubscriber :: TMVar (RefCount,TChan Presence) -- TODO: rename this, its not just locals | ||
85 | -- ... or make a seperate channel for remotes | ||
86 | |||
87 | -- rosterChannel - a channel and reference count where all roster change events are | ||
88 | -- announced | ||
89 | , rosterChannel :: TMVar (RefCount,TChan RosterEvent) | ||
90 | |||
91 | |||
92 | -- remoteUsers - a cache of remote users considered to be online. These are sent to a client | ||
93 | -- on connect so that it can populate it's notion of online users. | ||
94 | , remoteUsers :: TVar (Map Peer (RefCount,TVar (MultiMap JabberUser (JabberResource,JabberShow)))) | ||
95 | |||
96 | -- outGoingConnections - a set of channels that may be used to send messages to remote peers. | ||
97 | , outGoingConnections :: TVar (Map Peer (TChan OutBoundMessage, ThreadId)) | ||
98 | } | ||
99 | |||
100 | |||
101 | |||
102 | |||
103 | {- newPresenceState | ||
104 | - | ||
105 | - This is a smart constructor for the global state. | ||
106 | - This is currently used only from Main.start and PresenceState | ||
107 | - records are not created by any means other than this constructor. | ||
108 | -} | ||
109 | newPresenceState hostname = atomically $ do | ||
110 | tty <- newTVar "" | ||
111 | us <- newTVar (Set.empty) | ||
112 | subs <- newTVar (Map.empty) | ||
113 | locals_greedy <- newEmptyTMVar | ||
114 | rchan <- newEmptyTMVar | ||
115 | remotes <- newTVar (Map.empty) | ||
116 | server_connections <- newServerConnections | ||
117 | return $ PresenceState hostname tty us subs locals_greedy rchan remotes server_connections | ||
118 | |||
119 | |||
120 | data ClientSession = ClientSession { | ||
121 | localhost :: Peer, -- ByteString, | ||
122 | unix_uid :: (IORef (Maybe (UserID,L.ByteString))), | ||
123 | unix_resource :: (IORef (Maybe L.ByteString)), | ||
124 | chans :: TVar [RefCountedChan], | ||
125 | presence_state :: PresenceState | ||
126 | } | ||
127 | |||
60 | type RefCount = Int | 128 | type RefCount = Int |
61 | 129 | ||
62 | type JabberResource = L.ByteString | 130 | type JabberResource = L.ByteString |
@@ -70,18 +138,6 @@ splitResource (JID (Just n) p r ) = Just (JabberUser n p, r) | |||
70 | 138 | ||
71 | unsplitResource (JabberUser n p) r = JID (Just n) p r | 139 | unsplitResource (JabberUser n p) r = JID (Just n) p r |
72 | 140 | ||
73 | data PresenceState = PresenceState | ||
74 | { hostname :: Peer -- ByteString, TODO: remove this, its always LocalHost now | ||
75 | , currentTTY :: TVar ByteString | ||
76 | , activeUsers :: TVar (Set (UserName, Tty, ProcessID)) | ||
77 | , subscriberMap :: TVar (Map JID (RefCount,TChan Presence)) -- UNUSED as yet | ||
78 | , localSubscriber :: TMVar (RefCount,TChan Presence) -- TODO: rename this, its not just locals | ||
79 | -- ... or make a seperate channel for remotes | ||
80 | , rosterChannel :: TMVar (RefCount,TChan RosterEvent) | ||
81 | , remoteUsers :: TVar (Map Peer (RefCount,TVar (MultiMap JabberUser (JabberResource,JabberShow)))) | ||
82 | , outGoingConnections :: TVar (Map Peer (TChan OutBoundMessage, ThreadId)) | ||
83 | } | ||
84 | |||
85 | 141 | ||
86 | rosterPush msg state = do | 142 | rosterPush msg state = do |
87 | let rchan = rosterChannel state | 143 | let rchan = rosterChannel state |
@@ -102,14 +158,6 @@ getJabberUserForId muid = | |||
102 | ) | 158 | ) |
103 | muid | 159 | muid |
104 | 160 | ||
105 | data ClientSession = ClientSession { | ||
106 | localhost :: Peer, -- ByteString, | ||
107 | unix_uid :: (IORef (Maybe (UserID,L.ByteString))), | ||
108 | unix_resource :: (IORef (Maybe L.ByteString)), | ||
109 | chans :: TVar [RefCountedChan], | ||
110 | presence_state :: PresenceState | ||
111 | } | ||
112 | |||
113 | cmpJID newitem jid = do | 161 | cmpJID newitem jid = do |
114 | -- putStrLn $ "Comparing "<++>bshow jid | 162 | -- putStrLn $ "Comparing "<++>bshow jid |
115 | olditem <- parseHostNameJID jid | 163 | olditem <- parseHostNameJID jid |
@@ -513,16 +561,6 @@ update_presence locals_greedy subscribers state getStatus = | |||
513 | sendPresence chan jid status | 561 | sendPresence chan jid status |
514 | putStrLn $ bshow jid <++> " " <++> bshow status | 562 | putStrLn $ bshow jid <++> " " <++> bshow status |
515 | 563 | ||
516 | newPresenceState hostname = atomically $ do | ||
517 | tty <- newTVar "" | ||
518 | us <- newTVar (Set.empty) | ||
519 | subs <- newTVar (Map.empty) | ||
520 | locals_greedy <- newEmptyTMVar | ||
521 | rchan <- newEmptyTMVar | ||
522 | remotes <- newTVar (Map.empty) | ||
523 | server_connections <- newServerConnections | ||
524 | return $ PresenceState hostname tty us subs locals_greedy rchan remotes server_connections | ||
525 | |||
526 | sendProbes state jid = do | 564 | sendProbes state jid = do |
527 | L.putStrLn $ "sending probes for " <++> bshow jid | 565 | L.putStrLn $ "sending probes for " <++> bshow jid |
528 | withJust (name jid) $ \user -> do | 566 | withJust (name jid) $ \user -> do |