summaryrefslogtreecommitdiff
path: root/Presence/Presence.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Presence/Presence.hs')
-rw-r--r--Presence/Presence.hs17
1 files changed, 11 insertions, 6 deletions
diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 2344fb75..9660b29f 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -148,7 +148,7 @@ data PresenceState = PresenceState
148 , associatedPeers :: TVar (Map SockAddr ()) 148 , associatedPeers :: TVar (Map SockAddr ())
149 , server :: TMVar XMPPServer 149 , server :: TMVar XMPPServer
150 , keyToChan :: TVar (Map ConnectionKey Conn) 150 , keyToChan :: TVar (Map ConnectionKey Conn)
151 , consoleWriter :: ConsoleWriter 151 , consoleWriter :: Maybe ConsoleWriter
152 } 152 }
153 153
154 154
@@ -435,11 +435,11 @@ rewriteJIDForPeer jid = do
435 in (to',addr) 435 in (to',addr)
436 436
437deliverToConsole :: PresenceState -> IO () -> Stanza -> IO () 437deliverToConsole :: PresenceState -> IO () -> Stanza -> IO ()
438deliverToConsole state fail msg = do 438deliverToConsole PresenceState{ consoleWriter = Just cw } fail msg = do
439 putStrLn $ "TODO: deliver to console" 439 did1 <- writeActiveTTY cw msg
440 did1 <- writeActiveTTY (consoleWriter state) msg 440 did2 <- writeAllPty cw msg
441 did2 <- writeAllPty (consoleWriter state) msg
442 if not (did1 || did2) then fail else return () 441 if not (did1 || did2) then fail else return ()
442deliverToConsole _ fail _ = fail
443 443
444-- | deliver <message/> or error stanza 444-- | deliver <message/> or error stanza
445deliverMessage :: PresenceState 445deliverMessage :: PresenceState
@@ -636,6 +636,11 @@ informPeerPresence state k stanza = do
636 sendModifiedStanzaToClient (dup { stanzaFrom=Just from' }) 636 sendModifiedStanzaToClient (dup { stanzaFrom=Just from' })
637 (connChan con) 637 (connChan con)
638 638
639consoleClients :: PresenceState -> STM (Map Text ClientState)
640consoleClients PresenceState{ consoleWriter = Just cw } = readTVar (cwClients cw)
641consoleClients _ = return Map.empty
642
643
639answerProbe :: PresenceState 644answerProbe :: PresenceState
640 -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO () 645 -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO ()
641answerProbe state mto k chan = do 646answerProbe state mto k chan = do
@@ -671,7 +676,7 @@ answerProbe state mto k chan = do
671 replies <- runTraversableT $ do 676 replies <- runTraversableT $ do
672 cbu <- lift . atomically $ readTVar (clientsByUser state) 677 cbu <- lift . atomically $ readTVar (clientsByUser state)
673 let lpres = maybeToList $ Map.lookup u cbu 678 let lpres = maybeToList $ Map.lookup u cbu
674 cw <- lift . atomically $ readTVar (cwClients $ consoleWriter state) 679 cw <- lift . atomically $ consoleClients state
675 clientState <- liftT $ (lpres >>= Map.elems . networkClients) 680 clientState <- liftT $ (lpres >>= Map.elems . networkClients)
676 ++ Map.elems cw 681 ++ Map.elems cw
677 stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState)) 682 stanza <- liftIOMaybe $ atomically (readTVar (clientStatus clientState))