New "cookie" command for tox command-line interface.

1 files changed, 13 insertions, 11 deletions

diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index 840e2e6b..38763f9c 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -243,39 +243,41 @@ ping client addr = do
     hPutStrLn stderr $ show addr ++ " -pong-> " ++ show reply
     maybe (return False) (\Pong -> return True) $ join reply
 
-cookieRequest :: TVar [(SockAddr,(Int,NodeInfo))] -> PublicKey -> Client -> NodeInfo -> IO (Maybe Cookie)
-cookieRequest tvar myDhtKey client addr = do
+cookieRequest :: TransportCrypto -> Client -> NodeInfo -> IO (Maybe Cookie)
+cookieRequest crypto client addr = do
     let sockAddr = nodeAddr addr
+        nid = id2key $ nodeId addr
     let incAddr sockMap
             = case partition ((==sockAddr) . fst) sockMap of
-                    ([],xs)                              -> insert (sockAddr, (1  ,addr)) xs
-                    ([(_,(c,addr'))],xs) | addr' == addr -> insert (sockAddr, (c+1,addr)) xs
+                    ([],xs)                             -> (sockAddr, (1  ,nid)) : xs
+                    ([(_,(c,addr'))],xs) | addr' == nid -> (sockAddr, (c+1,nid)) : xs
                     anythingElse -> error $ "unreachable at " ++ __FILE__ ++ show __LINE__ ++ show anythingElse ++ show (sockAddr,addr)
         decAddr sockMap
             = case partition ((==sockAddr) . fst) sockMap of
-                    ([],xs)                              -> xs -- unreachable?
-                    ([(_,(1,addr'))],xs) | addr' == addr -> xs
-                    ([(_,(c,addr'))],xs) | addr' == addr -> insert (sockAddr,(c-1,addr)) xs
+                    ([],xs)                             -> xs -- unreachable?
+                    ([(_,(1,addr'))],xs) | addr' == nid -> xs
+                    ([(_,(c,addr'))],xs) | addr' == nid -> (sockAddr,(c-1,nid)) : xs
                     anythingElse -> error $ "unreachable at " ++ __FILE__ ++ show __LINE__ ++ show anythingElse ++ show (sockAddr,addr)
     sockMap <- atomically $ do
-            mp <- incAddr <$> readTVar tvar
-            writeTVar tvar mp
+            mp <- incAddr <$> readTVar (pendingCookies crypto)
+            writeTVar (pendingCookies crypto) mp
             return mp
     let cookieSerializer
             = MethodSerializer
                    { methodTimeout  = \tid addr -> do
-                        modifyTVar tvar decAddr
+                        modifyTVar (pendingCookies crypto) decAddr
                         return (addr, 5000000)
                    , method    = CookieRequestType
                    , wrapQuery = \tid src dst cr -> DHTCookieRequest $ wrapAsymm tid src dst (, cr)
                    , unwrapResponse = fmap snd . unCookie
                    }
-        cookieRequest = CookieRequest myDhtKey
+        cookieRequest = CookieRequest (transportPublic crypto)
     hPutStrLn stderr $ show addr ++ " <-- cookieRequest"
     reply <- QR.sendQuery client cookieSerializer cookieRequest addr
     hPutStrLn stderr $ show addr ++ " -cookieResponse-> " ++ show reply
     return $ join reply
 
+unCookie :: DHTMessage t -> Maybe (t Cookie)
 unCookie (DHTCookie n24 fcookie) = Just fcookie
 unCookie _ = Nothing