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