Fixed leak in toxToXmpp (due to use of Maybe monad forM_).

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