diff --git a/source/Network/Xmpp/Concurrent.hs b/source/Network/Xmpp/Concurrent.hs index ccfa84a..6fade93 100644 --- a/source/Network/Xmpp/Concurrent.hs +++ b/source/Network/Xmpp/Concurrent.hs @@ -187,6 +187,7 @@ newSession stream config realm mbSasl = runErrorT $ do ] (kill, sState, reader) <- ErrorT $ startThreadsWith writeSem stanzaHandler eh stream + (keepAlive config) idGen <- liftIO $ sessionStanzaIDs config let sess = Session { stanzaCh = stanzaChan , iqHandlers = iqHands diff --git a/source/Network/Xmpp/Concurrent/Threads.hs b/source/Network/Xmpp/Concurrent/Threads.hs index 37acca5..3137764 100644 --- a/source/Network/Xmpp/Concurrent/Threads.hs +++ b/source/Network/Xmpp/Concurrent/Threads.hs @@ -86,14 +86,15 @@ startThreadsWith :: TMVar (BS.ByteString -> IO (Either XmppFailure ())) -> (Stanza -> IO ()) -> TMVar EventHandlers -> Stream + -> Maybe Int -> IO (Either XmppFailure (IO (), TMVar Stream, ThreadId)) -startThreadsWith writeSem stanzaHandler eh con = do +startThreadsWith writeSem stanzaHandler eh con keepAlive = do -- read' <- withStream' (gets $ streamSend . streamHandle) con -- writeSem <- newTMVarIO read' conS <- newTMVarIO con - cp <- forkIO $ connPersist writeSem + cp <- forkIO $ connPersist keepAlive writeSem rdw <- forkIO $ readWorker stanzaHandler (noCon eh) conS return $ Right ( killConnection [rdw, cp] , conS @@ -115,9 +116,10 @@ startThreadsWith writeSem stanzaHandler eh con = do -- Acquires the write lock, pushes a space, and releases the lock. -- | Sends a blank space every 30 seconds to keep the connection alive. -connPersist :: TMVar (BS.ByteString -> IO a) -> IO () -connPersist sem = forever $ do +connPersist :: Maybe Int -> TMVar (BS.ByteString -> IO a) -> IO () +connPersist (Just delay) sem = forever $ do pushBS <- atomically $ takeTMVar sem _ <- pushBS " " atomically $ putTMVar sem pushBS - threadDelay 30000000 -- 30s + threadDelay (delay*1000000) +connPersist Nothing _ = return () diff --git a/source/Network/Xmpp/Concurrent/Types.hs b/source/Network/Xmpp/Concurrent/Types.hs index 92ea47e..ca5fa64 100644 --- a/source/Network/Xmpp/Concurrent/Types.hs +++ b/source/Network/Xmpp/Concurrent/Types.hs @@ -96,6 +96,9 @@ data SessionConfiguration = SessionConfiguration -> PeerStatus -> PeerStatus -> IO ()) + -- | How often to send keep-alives + -- 'Nothing' disables keep-alive + , keepAlive :: Maybe Int } instance Default SessionConfiguration where @@ -111,6 +114,7 @@ instance Default SessionConfiguration where , enableRoster = True , enablePresenceTracking = True , onPresenceChange = Nothing + , keepAlive = Just 30 } -- | Handlers to be run when the Xmpp session ends and when the Xmpp connection is