NetCrypto IdleEvents,TimeOuts

1 files changed, 29 insertions, 0 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index ce6cc8f7..6ef4539f 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -702,6 +702,35 @@ clientSession s@Session{..} sock cnum h = do
                  else do
                     rows <- sessionsReport
                     hPutClient h (showColumns (headers:rows))
+        -- session <N> set key val
+        ("session",s) | (idStr,"set",unstripped) <- twoWords s
+                      , (key,val,unstripped2) <- twoWords unstripped
+                      , let setmap = [("ncRequestInterval", \s x -> writeTVar (Tox.ncRequestInterval s) x)
+                                     ,("ncAliveInterval", \s x -> writeTVar (Tox.ncAliveInterval s) x)
+                                     ,("ncIdleEvent", \s x -> writeTVar (Tox.ncIdleEvent s) x)
+                                     ,("ncTimeOut", \s x -> writeTVar (Tox.ncTimeOut s) x)
+                                     ]
+                      , Just stmFunc <- Data.List.lookup key setmap
+                        -> cmd0 $ do
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> do
+                                    case readMaybe val of
+                                        Just (x::Int) -> do
+                                            atomically (stmFunc session x)
+                                            hPutClient h $ "Session " ++ idStr ++ ": " ++ key ++ " = " ++ val
+                                        _ -> 
+                                            hPutClient h $ "Invalid " ++ key ++ " value: " ++ val
+
+        -- report error when setting invalid keys
+        ("session",s) | (idStr,"set",unstripped) <- twoWords s
+                      , (key,val,unstripped2) <- twoWords unstripped
+                        -> cmd0 $ do
+                            lrSession <- strToSession idStr
+                            case lrSession of
+                                Left s -> hPutClient h s
+                                Right session -> hPutClient h $ "What is " ++ key ++ "?"
         -- session <N> tail
         -- show context (latest lossless messages)
         ("session", s) | (idStr,tailcmd,unstripped) <- twoWords s