launch ping machine on netcrypto conn

1 files changed, 4 insertions, 3 deletions

diff --git a/PingMachine.hs b/PingMachine.hs
index b714d71e..5cd70f95 100644
--- a/PingMachine.hs
+++ b/PingMachine.hs
@@ -48,17 +48,18 @@ data PingMachine = PingMachine
 -- 'pingFlag' is difficult to use properly because it is up to the caller to
 -- remember that the ping is already in progress.
 forkPingMachine
-    :: PingInterval -- ^ Milliseconds of idle before a ping is considered necessary.
+    :: String
+    -> PingInterval -- ^ Milliseconds of idle before a ping is considered necessary.
     -> TimeOut      -- ^ Milliseconds after 'PingIdle' before we signal 'PingTimeOut'.
     -> IO PingMachine
-forkPingMachine idle timeout = do
+forkPingMachine label idle timeout = do
     d <- interruptibleDelay
     flag <- atomically $ newTVar False
     canceled <- atomically $ newTVar False
     event <- atomically newEmptyTMVar
     started <- atomically $ newEmptyTMVar
     when (idle/=0) $ void . forkIO $ do
-        myThreadId >>= flip labelThread ("ping.watchdog")
+        myThreadId >>= flip labelThread ("Ping." ++ label) -- ("ping.watchdog")
         (>>=) (atomically (readTMVar started)) $ flip when $ do
         fix $ \loop -> do
             atomically $ writeTVar flag False