WIP Onion routing.

1 files changed, 13 insertions, 13 deletions

diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index c9adc860..a3f13ac7 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -105,7 +105,6 @@ data Routing = Routing
     , sched6      :: !( TVar (Int.PSQ POSIXTime) )
     , routing6    :: !( TVar (R.BucketList NodeInfo) )
     , committee6  :: TriadCommittee NodeId SockAddr
-    , orouter     :: OnionRouter
     }
 
 newRouting :: SockAddr -> TransportCrypto
@@ -124,8 +123,9 @@ newRouting addr crypto update4 update6 = do
     tentative_info6 <-
         maybe (tentative_info { nodeIP = tentative_ip6 })
               (\ip6 -> tentative_info { nodeIP = IPv6 ip6 })
-            <$> global6
-    orouter <- newOnionRouter
+            <$> case addr of
+                    SockAddrInet {} -> return Nothing
+                    _               -> global6
     atomically $ do
         let nobkts = R.defaultBucketCount :: Int
         tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts
@@ -134,7 +134,7 @@ newRouting addr crypto update4 update6 = do
         committee6 <- newTriadCommittee (update6 tbl6) -- updateIPVote tbl6 addr6
         sched4 <- newTVar Int.empty
         sched6 <- newTVar Int.empty
-        return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 orouter
+        return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6
 
 
 -- TODO: This should cover more cases
@@ -200,7 +200,7 @@ serializer :: PacketKind
                 -> (Message -> Maybe (Assym (Nonce8,pong)))
                 -> MethodSerializer TransactionId NodeInfo Message PacketKind ping (Maybe pong)
 serializer pktkind mkping mkpong = MethodSerializer
-        { methodTimeout  = 5
+        { methodTimeout  = \tid addr -> return (addr, 5000000)
         , method         = pktkind
         -- wrapQuery :: tid -> addr -> addr -> qry -> x
         , wrapQuery      = \tid src dst ping -> mkping $ wrapAssym tid src dst (, ping)
@@ -232,20 +232,20 @@ unwrapNodes (SendNodes ns) = (ns,ns,())
 
 getNodes :: Client -> NodeId -> NodeInfo -> IO (Maybe ([NodeInfo],[NodeInfo],()))
 getNodes client nid addr = do
-    hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid
+    -- hPutStrLn stderr $ show addr ++ " <-- getnodes " ++ show nid
     reply <- QR.sendQuery client (serializer GetNodesType DHTGetNodes unsendNodes) (GetNodes nid) addr
-    hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply
+    -- hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply
     return $ fmap unwrapNodes $ join reply
 
-updateRouting :: Client -> Routing -> NodeInfo -> Message -> IO ()
-updateRouting client routing naddr msg = do
+updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO ()
+updateRouting client routing orouter naddr msg = do
     let typ = fst $ dhtMessageType $ fst $ DHTTransport.encrypt (error "updateRouting") msg naddr
         tid = mapMessage (\n24 (n8,_) -> TransactionId n8 n24) msg
-    hPutStrLn stderr $ "updateRouting "++show (typ,tid)
+    -- hPutStrLn stderr $ "updateRouting "++show (typ,tid)
     -- TODO: check msg type
     case prefer4or6 naddr Nothing of
-        Want_IP4 -> updateTable client naddr (orouter routing) (routing4 routing) (committee4 routing) (sched4 routing)
-        Want_IP6 -> updateTable client naddr (orouter routing) (routing6 routing) (committee6 routing) (sched6 routing)
+        Want_IP4 -> updateTable client naddr orouter (routing4 routing) (committee4 routing) (sched4 routing)
+        Want_IP6 -> updateTable client naddr orouter (routing6 routing) (committee6 routing) (sched6 routing)
 
 updateTable :: Client -> NodeInfo -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO ()
 updateTable client naddr orouter tbl committee sched = do
@@ -262,7 +262,7 @@ toxKademlia client committee orouter var sched
                    { tblTransition = \tr -> do
                         io1 <- transitionCommittee committee tr
                         io2 <- touchBucket toxSpace (15*60) var sched tr
-                        hookBucketList orouter tr
+                        hookBucketList toxSpace var orouter tr
                         return $ do
                             io1 >> io2
                             {-