Command 'r' to generate random node ids.

2 files changed, 15 insertions, 0 deletions

diff --git a/dht/dht-client.cabal b/dht/dht-client.cabal
index a2a86b95..feaf2ed4 100644
--- a/dht/dht-client.cabal
+++ b/dht/dht-client.cabal
@@ -334,6 +334,7 @@ executable dhtd
                      , filepath
                      , process
                      , cereal-conduit >= 0.7.3
+                     , cryptonite
 
   if flag(thread-debug)
     build-depends: time
diff --git a/dht/examples/dhtd.hs b/dht/examples/dhtd.hs
index 9c03a4f9..d028a308 100644
--- a/dht/examples/dhtd.hs
+++ b/dht/examples/dhtd.hs
@@ -28,6 +28,7 @@ import Control.Concurrent.STM.TMChan
 import Control.Exception
 import Control.Monad
 import Control.Monad.IO.Class (liftIO)
+import Crypto.Random (getRandomBytes)
 import Data.Array.MArray (getAssocs)
 import Data.Bool
 import Data.Bits (xor)
@@ -400,6 +401,7 @@ clientSession s@Session{..} sock cnum h = do
             , ["nid"]
             , ["lan"]
             , ["ls"]
+            , ["r"]
             , ["k"]
             , ["roster"]
             , ["sessions"]
@@ -553,6 +555,18 @@ clientSession s@Session{..} sock cnum h = do
                                          , ("node-id", show $ thisNode bkts)
                                          , ("network", netname) ]
 
+        ("r", s) | Just DHT{dhtQuery,dhtBuckets} <- Map.lookup netname dhts
+                 , Just DHTQuery{qsearch} <- Map.lookup "node" dhtQuery
+                   -> cmd0 $ do
+                        ni <- atomically $ thisNode <$> readTVar dhtBuckets
+                        let kad = searchSpace qsearch
+                            nid = kademliaLocation kad ni
+                            b = case readMaybe $ strp s of
+                                    Nothing -> bucketRange 0 True
+                                    Just n  -> bucketRange n False
+                        rnid <- kademliaSample kad getRandomBytes nid b
+                        hPutClient h $ show rnid
+
         --  TODO: online documentation.
         --
         --  k - manage key-pairs