summaryrefslogtreecommitdiff
path: root/Presence
diff options
context:
space:
mode:
Diffstat (limited to 'Presence')
-rw-r--r--Presence/XMPPServer.hs7
1 files changed, 6 insertions, 1 deletions
diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 60cfec74..c037eb63 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -1089,6 +1089,9 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
1089 let es' = mapMaybe metadata es 1089 let es' = mapMaybe metadata es
1090 metadata (Left s) = Just s 1090 metadata (Left s) = Just s
1091 metadata _ = Nothing 1091 metadata _ = Nothing
1092 -- TODO: Issuing RecipientUnavailable for all errors is a presence leak
1093 -- and protocol violation
1094 -- TODO: IDMangler can be used for better targetted error delivery.
1092 let fail stanza = do 1095 let fail stanza = do
1093 wlog $ "failed delivery: " ++ show (stanzaId stanza) 1096 wlog $ "failed delivery: " ++ show (stanzaId stanza)
1094 quitVar <- atomically newEmptyTMVar 1097 quitVar <- atomically newEmptyTMVar
@@ -1097,10 +1100,10 @@ forkConnection sv xmpp k laddr pingflag src snk stanzas = do
1097 -- sendReply quitVar (Error RecipientUnavailable tag) reply replyto 1100 -- sendReply quitVar (Error RecipientUnavailable tag) reply replyto
1098 replystanza <- stanzaFromList (Error RecipientUnavailable tag) reply 1101 replystanza <- stanzaFromList (Error RecipientUnavailable tag) reply
1099 xmppDeliverMessage xmpp (wlog $ "discarded error delivery fail") replystanza 1102 xmppDeliverMessage xmpp (wlog $ "discarded error delivery fail") replystanza
1100 -- TODO: queue or save es' stanzas for re-connect?
1101 notError s = case stanzaType s of 1103 notError s = case stanzaType s of
1102 Error {} -> False 1104 Error {} -> False
1103 _ -> True 1105 _ -> True
1106 -- TODO: Probably some stanzas should be queued or saved for re-connect.
1104 mapM_ fail $ filter notError (maybeToList last ++ es') 1107 mapM_ fail $ filter notError (maybeToList last ++ es')
1105 wlog $ "end post-queue fork: " ++ show k 1108 wlog $ "end post-queue fork: " ++ show k
1106 output <- atomically newTChan 1109 output <- atomically newTChan
@@ -1530,6 +1533,8 @@ monitor sv params xmpp = do
1530 _ -> return () 1533 _ -> return ()
1531 _ -> return () 1534 _ -> return ()
1532 let deliver replyto = do 1535 let deliver replyto = do
1536 -- TODO: Issuing RecipientUnavailable for all errors is a presence leak
1537 -- and protocol violation
1533 let fail = do 1538 let fail = do
1534 wlog $ "Failed delivery id="++show (stanzaId stanza) -- TODO 1539 wlog $ "Failed delivery id="++show (stanzaId stanza) -- TODO
1535 reply <- makeErrorStanza stanza 1540 reply <- makeErrorStanza stanza