From c6bcfc88986d56d0495315d46d4c8277b7425029 Mon Sep 17 00:00:00 2001 From: Joe Crayne Date: Tue, 7 Jan 2020 13:15:53 -0500 Subject: Fixed leak in toxToXmpp (due to use of Maybe monad forM_). --- dht/Presence/Stanza/Types.hs | 1 + dht/ToxToXMPP.hs | 44 +++++++++++++++++++++++--------------------- 2 files changed, 24 insertions(+), 21 deletions(-) diff --git a/dht/Presence/Stanza/Types.hs b/dht/Presence/Stanza/Types.hs index 7275c8ab..8fc23f84 100644 --- a/dht/Presence/Stanza/Types.hs +++ b/dht/Presence/Stanza/Types.hs @@ -1,4 +1,5 @@ {-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE StrictData #-} module Stanza.Types where import Control.Concurrent.STM diff --git a/dht/ToxToXMPP.hs b/dht/ToxToXMPP.hs index 1420c642..aec8f499 100644 --- a/dht/ToxToXMPP.hs +++ b/dht/ToxToXMPP.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE BangPatterns #-} {-# LANGUAGE CPP #-} {-# LANGUAGE GADTs #-} {-# LANGUAGE LambdaCase #-} @@ -103,28 +104,29 @@ toxToXmpp store_invite _ me theirhost = do [ attr "style" "font-weight:bold; color:red" ] (T.pack $ "Unhandled message: " ++ show (msgID toxmsg)) - flip fix available $ \loop status -> do + flip fix available $ \loop !status -> do m <- await - forM_ m $ \(addr,x) -> do - let im_from = (Just $ toxJID theirhost addr) - case x of - Pkt USERSTATUS :=> Identity st -> do - let status' = status { presenceShow = toxUserStatus st } - xmppPresence "jabber:server" im_from status' - loop status' - - Pkt STATUSMESSAGE :=> Identity bs -> do - let status' = status { presenceStatus = [("",bs)] } - xmppPresence "jabber:server" im_from status' - loop status' - - Pkt ONLINE :=> _ -> do - xmppPresence "jabber:server" im_from status - loop status - - x -> do - statelessMessages addr im_from x - loop status + case m of + Just (addr,x) -> let im_from = Just $ toxJID theirhost addr in case x of + + Pkt USERSTATUS :=> Identity st -> do + let status' = status { presenceShow = toxUserStatus st } + xmppPresence "jabber:server" im_from status' + loop status' + Pkt STATUSMESSAGE :=> Identity bs -> do + let status' = status { presenceStatus = [("",bs)] } + xmppPresence "jabber:server" im_from status' + loop status' + + Pkt ONLINE :=> _ -> do + xmppPresence "jabber:server" im_from status + loop status + + x -> do + statelessMessages addr im_from x + loop status + + Nothing -> return () xmppPresence :: Monad m => Text -> Maybe Text -> StanzaType -> ConduitM i XML.Event m () xmppPresence namespace mjid p = do -- cgit v1.2.3