1 files changed, 38 insertions, 24 deletions

diff --git a/examples/dhtd.hs b/examples/dhtd.hs
index 8ceafd00..89b747be 100644
--- a/examples/dhtd.hs
+++ b/examples/dhtd.hs
@@ -150,18 +150,19 @@ data DHTQuery nid ni = forall addr r tok.
 
 data DHTAnnouncable nid = forall dta tok ni r.
                         ( Show r
-                        , Typeable dta
-                        , Typeable tok
-                        , Typeable r
-                        , Typeable ni
+                        , Typeable dta -- information being announced
+                        , Typeable tok -- token
+                        , Typeable r   -- search result
+                        , Typeable ni  -- node
                         ) => DHTAnnouncable
-    { announceParseData :: String -> Either String dta
-    , announceParseToken :: dta -> String -> Either String tok
+    { announceParseData    :: String -> Either String dta
+    , announceParseToken   :: dta -> String -> Either String tok
     , announceParseAddress :: String -> Either String ni
-    , announceSendData :: Either (dta -> r -> IO (Maybe r))
-                                 (dta -> tok -> Maybe ni -> IO (Maybe r))
-    , announceInterval :: POSIXTime
-    , qresultAddr :: dta -> nid
+    , announceSendData     :: Either (dta -> r -> IO (Maybe r)) -- TODO ( String {- search name -}
+                                                                --      , PublicKey {- me -} -> dta -> r -> IO ())
+                                     (dta -> tok -> Maybe ni -> IO (Maybe r))
+    , announceInterval     :: POSIXTime
+    , announceTarget       :: dta -> nid
     }
 
 data DHTSearch nid ni = forall addr tok r. DHTSearch
@@ -584,6 +585,7 @@ clientSession s@Session{..} sock cnum h = do
                         hPutClient h . showReport $ map mkrow ks ++ case skey >>= encodeSecret of
                             Just x  -> [("",""),("dht-key:",B.unpack x)]
                             Nothing -> []
+                 -- TODO | ("sel":secs) <- words s -> select active key
                  | ("add":secs) <- words s
                  , mbSecs <- map (decodeSecret . B.pack) secs
                  , all isJust mbSecs -> cmd0 $ do
@@ -783,7 +785,7 @@ clientSession s@Session{..} sock cnum h = do
                                 DHTAnnouncable { announceSendData
                                                , announceParseData
                                                , announceInterval
-                                               , qresultAddr } <- a
+                                               , announceTarget } <- a
                                 DHTQuery { qsearch } <- q
                                 asend <- either (const Nothing) Just announceSendData
                                 Refl <- matchingTok qsearch asend
@@ -793,7 +795,7 @@ clientSession s@Session{..} sock cnum h = do
                                 DHTAnnouncable { announceSendData
                                                , announceParseData
                                                , announceInterval
-                                               , qresultAddr } <- a
+                                               , announceTarget } <- a
                                 DHTQuery { qsearch } <- q
                                 asend <- either (const Nothing) Just announceSendData
                                 Refl <- matchingNI qsearch asend
@@ -802,7 +804,7 @@ clientSession s@Session{..} sock cnum h = do
                                 DHTAnnouncable { announceSendData
                                                , announceParseData
                                                , announceInterval
-                                               , qresultAddr } <- a
+                                               , announceTarget } <- a
                                 DHTQuery { qsearch } <- q
                                 asend <- either (const Nothing) Just announceSendData
                                 (Refl, Refl) <- matchingResult qsearch asend
@@ -813,12 +815,12 @@ clientSession s@Session{..} sock cnum h = do
                                     doit op announcer
                                             akey
                                             (AnnounceMethod qsearch (Right asend) dhtBuckets
-                                                            (qresultAddr dta)
+                                                            (announceTarget dta)
                                                             announceInterval)
                                             dta
                                     case op of
-                                        '+' -> hPutClient h $ "Announcing at " ++ show (qresultAddr dta) ++ "."
-                                        '-' -> hPutClient h $ "Canceling " ++ show (qresultAddr dta) ++ "."
+                                        '+' -> hPutClient h $ "Announcing at " ++ show (announceTarget dta) ++ "."
+                                        '-' -> hPutClient h $ "Canceling " ++ show (announceTarget dta) ++ "."
                         let aerror = unlines
                                 [ "announce error."
                                 , "method = " ++ method
@@ -1136,7 +1138,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                                                               , announceParseData = readEither
                                                               , announceParseToken = const $ readEither
                                                               , announceInterval = 60 -- TODO: Is one minute good?
-                                                              , qresultAddr = (read . show) -- TODO: InfoHash -> NodeId -- peer
+                                                              , announceTarget = (read . show) -- TODO: InfoHash -> NodeId -- peer
                                                               })
                                     , ("port", DHTAnnouncable { announceParseData = readEither
                                                               , announceParseToken = \_ _ -> return ()
@@ -1147,7 +1149,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                                                                     Just _ -> return Nothing
                                                               , announceInterval = 0 -- TODO: The "port" setting should probably
                                                                                      -- be a command rather than an announcement.
-                                                              , qresultAddr = const $ Mainline.zeroID
+                                                              , announceTarget = const $ Mainline.zeroID
                                                               })]
 
                     , dhtSecretKey = return Nothing
@@ -1243,7 +1245,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                                                                , announceParseAddress = readEither
                                                                , announceParseToken = const $ readEither
                                                                , announceParseData = fmap Tox.id2key . readEither
-                                                               , qresultAddr = Tox.key2id -- toxid
+                                                               , announceTarget = Tox.key2id -- toxid
 
                     -- For peers we are announcing ourselves to, if we are not
                     -- announced to them toxcore tries every 3 seconds to
@@ -1261,6 +1263,12 @@ main = runResourceT $ liftBaseWith $ \resT -> do
 
                                                                })
                                     -- FIXME: Should use announceSendData = Left ...
+                                    --
+                                    --       Current                 Desired
+                                    -- ni  = AnnouncedRendezvous --> NodeInfo
+                                    -- r   = ()                  --> Rendezvous
+                                    -- tok = ()                  --> Nonce32 ... or PublicKey(me) ?
+                                    -- dta = PublicKey(me)       --> PublicKey(them)
                                     , ("dhtkey", DHTAnnouncable { announceSendData = Right $ \pubkey () -> \case
                                                                     Just addr -> do
                                                                         dkey <- Tox.getContactInfo tox
@@ -1270,10 +1278,10 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                                                                             (pubkey,Tox.OnionDHTPublicKey dkey)
                                                                         return $ Just ()
                                                                     Nothing -> return Nothing
-                                                               , announceParseAddress = readEither
-                                                               , announceParseToken = \_ _ -> return ()
-                                                               , announceParseData = fmap Tox.id2key . readEither
-                                                               , qresultAddr = Tox.key2id
+                                                                , announceParseAddress = readEither
+                                                                , announceParseToken = \_ _ -> return ()
+                                                                , announceParseData = fmap Tox.id2key . readEither
+                                                                , announceTarget = Tox.key2id
 
                     -- We send this packet every 30 seconds if there is more
                     -- than one peer (in the 8) that says they our friend is
@@ -1293,6 +1301,12 @@ main = runResourceT $ liftBaseWith $ \resT -> do
 
                                                                })
                                     -- FIXME: Should use announceSendData = Left ...
+                                    --
+                                    --       Current                 Desired
+                                    -- ni  = AnnouncedRendezvous --> NodeInfo
+                                    -- r   = ()                  --> Rendezvous
+                                    -- tok = NoSpam              --> Nonce32 ... or PublicKey(me) ?
+                                    -- dta = PublicKey(me)       --> PublicKey(them) + NoSpam
                                     , ("friend", DHTAnnouncable { announceSendData = Right $ \pubkey nospam -> \case
                                                                     Just addr -> do
                                                                         let fr = Tox.FriendRequest nospam txt
@@ -1312,7 +1326,7 @@ main = runResourceT $ liftBaseWith $ \resT -> do
                                                                               (Tox.verifyChecksum pubkey)
                                                                               chksum
                                                                         return nospam
-                                                                , qresultAddr = Tox.key2id
+                                                                , announceTarget = Tox.key2id
 
                     -- Friend requests are sent with exponentially increasing
                     -- interval of 2 seconds, 4 seconds, 8 seconds, etc... in