From 056314446f1ac2d9d493d7598614450f8b6c8e65 Mon Sep 17 00:00:00 2001
From: John Millikin <jmillikin@gmail.com>
Date: Fri, 7 May 2010 19:45:27 +0000
Subject: [PATCH] In the "echo" example, send a ping every 60 seconds to
 prevent the server from timing out the connection.

---
 examples/echo.hs | 24 ++++++++++++++++++++++++
 1 file changed, 24 insertions(+)

diff --git a/examples/echo.hs b/examples/echo.hs
index 53d5790..49f46e5 100644
--- a/examples/echo.hs
+++ b/examples/echo.hs
@@ -21,13 +21,16 @@
 -- FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR
 -- OTHER DEALINGS IN THE SOFTWARE.
 
+{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
 -- XMPP imports
 import Network
 import Network.Protocol.XMPP
+import Data.XML.Types
 
 -- other imports
+import Control.Concurrent
 import Control.Monad
 import Control.Monad.IO.Class
 import qualified Data.Text.Lazy as T
@@ -71,6 +74,12 @@ runEcho hostname user password = do
 	-- 'throwError' and 'catchError' computations to handle errors within an XMPP
 	-- session.
 	res <- runClient server jid username password $ do
+		
+		-- Some servers will close the XMPP connection after some period
+		-- of inactivity. For this example, we'll simply send a "ping" every
+		-- 60 seconds
+		getSession >>= liftIO . forkIO . sendPings 60
+		
 		-- When running a client session, most servers require the user to
 		-- "bind" their JID before sending any stanzas.
 		boundJID <- bindJID jid
@@ -111,6 +120,21 @@ echo msg = Message
 	, messagePayloads = messagePayloads msg
 	}
 
+-- Send a "ping" occasionally, to prevent server timeouts from
+-- closing the connection.
+sendPings :: Integer -> Session -> IO ()
+sendPings seconds s = forever send where
+	send = do
+		-- Ignore errors
+		runXMPP s $ putStanza ping
+		threadDelay $ fromInteger $ 1000000 * seconds
+	ping = (emptyIQ IQGet)
+		{ iqPayload = Just (Element pingName [] [])
+		}
+
+pingName :: Name
+pingName = Name "ping" (Just "urn:xmpp:ping") Nothing
+
 main :: IO ()
 main = do
 	args <- getArgs
-- 
2.38.5