extra careful ping bump

1 files changed, 7 insertions, 2 deletions

diff --git a/Presence/Server.hs b/Presence/Server.hs
index da0cda17..c7162265 100644
--- a/Presence/Server.hs
+++ b/Presence/Server.hs
@@ -622,8 +622,13 @@ pingCancel me = do
 pingBump :: PingMachine -> IO ()
 pingBump me = do
     b <- atomically $ do
-            when (pingIdle me /= 0) $ 
-                putTMVar (pingDelay me) (1000*pingIdle me,PingIdle)
+            when (pingIdle me /= 0) $ do
+              e <- tryReadTMVar (pingDelay me)
+              case e of
+                  Just (0,PingTimeOut) -> return () -- canceled/fired
+                  Just _  -> retry
+                  Nothing -> putTMVar (pingDelay me)
+                                      (1000*pingIdle me,PingIdle)
             readTVar (pingStarted me)
     when b $ throwTo (pingThread me) $ ErrorCall ""