blob: 639e834be0f73a665034594db69590455f08e9a1 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
|
module MUC where
import Control.Monad
import Control.Concurrent.STM
import qualified Data.Map.Strict as Map
;import Data.Map.Strict (Map)
import Chat
import ConnectionKey
import Data.Text (Text)
data MUC = MUC
{ mucRooms :: TVar (Map Text (Room ClientAddress))
, mucChan :: TChan MUCEvent
}
data MUCEvent = MUCCreate Text{-room-} Text{-JID-} Text{-nick-} (Room ClientAddress)
newMUC :: STM MUC
newMUC = MUC <$> newTVar Map.empty <*> newBroadcastTChan
mucRoomList :: MUC -> IO [(Text{-room-},Maybe Text{-friendly room name-})]
mucRoomList muc = atomically $ do
rs <- Map.toList <$> readTVar (mucRooms muc)
forM rs $ \(rkey,r) -> do
fn <- roomFriendlyName r
return (rkey,fn)
mucRoomOccupants :: MUC -> Text{-room-} -> IO [(Text{-nick-},Maybe Text{-friendly name-})]
mucRoomOccupants muc rkey = atomically $ do
mr <- Map.lookup rkey <$> readTVar (mucRooms muc)
case mr of
Nothing -> return []
Just r -> roomOccupants r
mucReservedNick :: MUC -> Text{-room-} -> IO (Maybe (Text{-JID-} -> IO (Maybe Text)))
mucReservedNick muc rkey = atomically $ do
mr <- Map.lookup rkey <$> readTVar (mucRooms muc)
case mr of
Nothing -> return Nothing
Just r -> return $ Just $ \jid -> atomically $ roomReservedNick r jid
mucJoinRoom :: MUC -> Text{-JID-} -> Text{-nick-} -> Text{-room-} -> ClientAddress -> STM (JoinedRoom ClientAddress)
mucJoinRoom muc jid nick rkey k = do
mr <- Map.lookup rkey <$> readTVar (mucRooms muc)
case mr of
Nothing -> do
-- create room.
r <- newRoom
v <- joinRoom k r (Just jid) nick
modifyTVar' (mucRooms muc) $ Map.insert rkey r
writeTChan (mucChan muc) $ MUCCreate rkey jid nick r
return v
Just r -> do
-- join room.
v <- joinRoom k r (Just jid) nick
return v
|
