summaryrefslogtreecommitdiff
path: root/Presence/Chat.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/Chat.hs')
-rw-r--r--Presence/Chat.hs26
1 files changed, 13 insertions, 13 deletions
diff --git a/Presence/Chat.hs b/Presence/Chat.hs
index 172c5242..b7343b5a 100644
--- a/Presence/Chat.hs
+++ b/Presence/Chat.hs
@@ -76,6 +76,7 @@ newtype RoomHandle = RH (TVar (Maybe ChatTransaction))
76 76
77data JoinedRoom k = JoinedRoom 77data JoinedRoom k = JoinedRoom
78 { joinedRoom :: Room k 78 { joinedRoom :: Room k
79 , joinedNick :: Text
79 , roomHandle :: RoomHandle 80 , roomHandle :: RoomHandle
80 , roomTransactions :: TChan ChatTransaction 81 , roomTransactions :: TChan ChatTransaction
81 } 82 }
@@ -110,29 +111,28 @@ joinRoom k room jid nick = do
110 v <- newTVar (Just $ ChatTransaction no jid nick [Join]) 111 v <- newTVar (Just $ ChatTransaction no jid nick [Join])
111 modifyTVar' (roomDesiredTransaction room) $ Map.insert k v 112 modifyTVar' (roomDesiredTransaction room) $ Map.insert k v
112 c <- dupTChan (roomChan room) 113 c <- dupTChan (roomChan room)
113 return $ JoinedRoom room (RH v) c 114 return $ JoinedRoom room nick (RH v) c
114 115
115partRoom :: JoinedRoom k -> Maybe Text -> Text -> STM () 116partRoom :: JoinedRoom k -> Maybe Text -> STM ()
116partRoom (JoinedRoom room (RH v) c) jid nick = do 117partRoom (JoinedRoom room nick (RH v) c) jid = do
117 writeTVar v Nothing -- Cancel pending chat. 118 writeTVar v Nothing -- Cancel pending chat.
118 sendChat (JoinedRoom room (RH v) c) jid nick [Part] 119 sendChat (JoinedRoom room nick (RH v) c) jid [Part]
119 return () 120 return ()
120 121
121sendChat :: JoinedRoom k -> Maybe Text -> Text -> [ChatEvent] -> STM Bool 122sendChat :: JoinedRoom k -> Maybe Text -> [ChatEvent] -> STM Bool
122sendChat (JoinedRoom room (RH v) _) jid nick chat = do 123sendChat (JoinedRoom room nick (RH v) _) jid chat = do
123 mpending <- readTVar v 124 mpending <- readTVar v
125 no <- readTVar $ roomFutureSeqNo room
124 case mpending of 126 case mpending of
125 Nothing -> do 127 Just (ChatTransaction no' _ _ _) | no' >= no -> return False
126 no <- readTVar $ roomFutureSeqNo room 128 _ -> do
127 writeTVar v (Just $ ChatTransaction no jid nick chat) 129 writeTVar v (Just $ ChatTransaction no jid nick chat)
128 return True 130 return True
129 Just pending -> do
130 return False
131 131
132-- | Blocks until a transaction occurs. Optionally, a failed transaction will 132-- | Blocks until a transaction occurs. Optionally, a failed transaction will
133-- be automatically renewed. 133-- be automatically renewed.
134readRoom :: Ord k => k -> JoinedRoom k -> STM (Bool, ChatTransaction) 134readRoom :: Ord k => k -> JoinedRoom k -> STM (Bool, ChatTransaction)
135readRoom k (JoinedRoom room (RH v) c) = do 135readRoom k (JoinedRoom room _ (RH v) c) = do
136 mpending <- readTVar v 136 mpending <- readTVar v
137 final <- readTChan c 137 final <- readTChan c
138 case mpending of 138 case mpending of
@@ -198,7 +198,7 @@ roomCommit room k t = do
198 modifyTVar' (roomFutureSeqNo room) succ 198 modifyTVar' (roomFutureSeqNo room) succ
199 writeTChan (roomChan room) t 199 writeTChan (roomChan room) t
200 v <- validateTransaction room k t 200 v <- validateTransaction room k t
201 trace ("roomCommit " ++ show v) $ return () 201 trace ("roomCommit " ++ show v ++ " " ++ show t) $ return ()
202 case v of 202 case v of
203 Valid Outside Inside -> do 203 Valid Outside Inside -> do
204 modifyTVar' (roomMembers room) $ Map.insert (chatSender t) PerMember 204 modifyTVar' (roomMembers room) $ Map.insert (chatSender t) PerMember
@@ -209,7 +209,7 @@ roomCommit room k t = do
209 modifyTVar' (roomMembers room) $ Map.delete (chatSender t) 209 modifyTVar' (roomMembers room) $ Map.delete (chatSender t)
210 fin 210 fin
211 Valid _ _ -> fin 211 Valid _ _ -> fin
212 _ -> return () 212 bad -> trace ("validateTransaction: " ++ show bad) $ return ()
213 213
214roomPending :: Ord k => Room k -> STM (Map k ChatTransaction) 214roomPending :: Ord k => Room k -> STM (Map k ChatTransaction)
215roomPending room = do 215roomPending room = do