new interval comand, modifies all intervals at once

        session 0 interval
                -- shows the values of intervals on session 0
        session 0 interval 0.5
                -- half all the intervals on session 0

1 files changed, 24 insertions, 0 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index db56ec24..bf7d7162 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -764,6 +764,30 @@ clientSession s@Session{..} sock cnum h = do
                                         _ -> 
                                             hPutClient h $ "Invalid " ++ key ++ " value: " ++ val
 
+        -- session <N> interval factor
+        ("session",s) | (idStr,"interval",unstripped) <- twoWords s
+                      , val <- strp unstripped
+                        -> cmd0 $ do
+                            lrSession <- strToSession idStr
+                            let displayIntervals session = atomically $ do
+                                intervals <- forM [Tox.ncRequestInterval,Tox.ncAliveInterval, Tox.ncIdleEvent, Tox.ncTimeOut] $ \i -> readTVar (i session)
+                                let keys = ["ncRequestInterval","ncAliveInterval","ncIdleEvent","ncTimeOut"]
+                                return (intercalate "\n" $
+                                            map (\(key,val) -> "Session " ++ idStr ++ ": " ++ key ++ " = " ++ val)
+                                                (zip keys (map show intervals)))
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case readMaybe val of
+                                        Just (factor::Double) -> do
+                                             atomically $ do
+                                                modifyTVar (Tox.ncRequestInterval session) (round . (*factor) . fromIntegral)
+                                                modifyTVar (Tox.ncAliveInterval session) (round . (*factor) . fromIntegral)
+                                                modifyTVar (Tox.ncIdleEvent session) (round . (*factor) . fromIntegral)
+                                                modifyTVar (Tox.ncTimeOut session) (round . (*factor) . fromIntegral)
+                                             displayIntervals session >>= hPutClient h
+                                        _ -> displayIntervals session >>= hPutClient h . (("No parse (" ++ show val ++ ").\n") ++)
+
         -- report error when setting invalid keys
         ("session",s) | (idStr,"set",unstripped) <- twoWords s
                       , (key,val,unstripped2) <- twoWords unstripped