4 files changed, 57 insertions, 24 deletions

diff --git a/OnionRouter.hs b/OnionRouter.hs
new file mode 100644
index 00000000..15304221
--- /dev/null
+++ b/OnionRouter.hs
@@ -0,0 +1,31 @@
+module OnionRouter where
+
+import Crypto.Tox
+import Network.Kademlia
+import Network.Kademlia.Routing
+import Network.QueryResponse
+import Network.Tox.NodeId
+import Network.Tox.Onion.Transport
+
+import Network.Socket (SockAddr)
+import Control.Concurrent.STM
+
+newtype RouteId = RouteId Int
+ deriving Show
+
+data OnionRouter
+
+newOnionRouter :: IO OnionRouter
+newOnionRouter = return _todo
+
+lookupSender :: OnionRouter -> SockAddr -> Nonce8 -> IO (Maybe (NodeInfo, RouteId))
+lookupSender _ _ _ = return Nothing -- todo
+
+lookupRoute :: OnionRouter -> NodeInfo -> RouteId -> IO (Maybe OnionRoute)
+lookupRoute _ _ _ = return Nothing -- todo
+
+hookQueries :: OnionRouter -> (tid -> Nonce8) -> TransactionMethods d tid x -> TransactionMethods d tid x
+hookQueries _ n8 tmethods = tmethods -- todo
+
+hookBucketList :: OnionRouter -> RoutingTransition ni -> STM ()
+hookBucketList _ _ = return () -- todo
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 3c5fc955..7814046e 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -93,6 +93,7 @@ import qualified Network.Tox.Onion.Transport as Onion
 import qualified Network.Tox.Onion.Handlers as Onion
 import Network.Tox.Crypto.Transport (NetCrypto)
 import Text.XXD
+import OnionRouter
 
 newCrypto :: IO TransportCrypto
 newCrypto = do
@@ -157,9 +158,10 @@ newClient :: (DRG g, Show addr, Show meth) =>
                 -> (x -> MessageClass String meth DHT.TransactionId)
                 -> (Maybe addr -> IO addr)
                 -> (meth -> Maybe (MethodHandler String DHT.TransactionId addr x))
+                -> (forall d. TransactionMethods d DHT.TransactionId x -> TransactionMethods d DHT.TransactionId x)
                 -> (Client String meth DHT.TransactionId addr x -> Transport String addr x -> Transport String addr x)
                 -> IO (Client String meth DHT.TransactionId addr x)
-newClient drg net classify selfAddr handlers modifynet = do
+newClient drg net classify selfAddr handlers modifytbl modifynet = do
     -- If we have 8-byte keys for IntMap, then use it for transaction lookups.
     -- Otherwise, use ordinary Map.  The details of which will be hidden by an
     -- existential closure (see mkclient below).
@@ -176,7 +178,7 @@ newClient drg net classify selfAddr handlers modifynet = do
     let dispatch tbl var handlers = DispatchMethods
                 { classifyInbound = classify
                 , lookupHandler = handlers -- var
-                , tableMethods = tbl
+                , tableMethods = modifytbl tbl
                 }
         mkclient (tbl,var) handlers =
             let client = Client
@@ -224,11 +226,12 @@ newTox keydb addr = do
     crypto <- newCrypto
     drg <- drgNew
     let lookupClose _ = return Nothing
-    (dhtcrypt,onioncrypt,cryptonet) <- toxTransport crypto lookupClose udp
-
     routing <- DHT.newRouting addr crypto updateIP updateIP
+
+    (dhtcrypt,onioncrypt,cryptonet) <- toxTransport crypto (DHT.orouter routing) lookupClose udp
+
     let dhtnet0 = layerTransport (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
-    dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr routing) (DHT.handlers routing)
+    dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr routing) (DHT.handlers routing) id
                     $ \client net -> onInbound (DHT.updateRouting client routing) net
 
     toks <- do
@@ -242,6 +245,7 @@ newTox keydb addr = do
                                     (flip Onion.OnionDestination Nothing)
                            $ nodeInfo zeroID addr)
                     (Onion.handlers onionnet routing toks keydb)
+                    (hookQueries (DHT.orouter routing) DHT.transactionKey)
                     (const id)
     return Tox
         { toxDHT = dhtclient
diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs
index 4e43c4a7..c9adc860 100644
--- a/src/Network/Tox/DHT/Handlers.hs
+++ b/src/Network/Tox/DHT/Handlers.hs
@@ -14,6 +14,7 @@ import Network.Address               (WantIP (..), ipFamily, testIdBit,fromSockA
 import qualified Network.Kademlia.Routing as R
 import Control.TriadCommittee
 import System.Global6
+import OnionRouter
 
 import qualified Data.ByteArray as BA
 import qualified Data.ByteString.Char8 as C8
@@ -104,6 +105,7 @@ data Routing = Routing
     , sched6      :: !( TVar (Int.PSQ POSIXTime) )
     , routing6    :: !( TVar (R.BucketList NodeInfo) )
     , committee6  :: TriadCommittee NodeId SockAddr
+    , orouter     :: OnionRouter
     }
 
 newRouting :: SockAddr -> TransportCrypto
@@ -123,6 +125,7 @@ newRouting addr crypto update4 update6 = do
         maybe (tentative_info { nodeIP = tentative_ip6 })
               (\ip6 -> tentative_info { nodeIP = IPv6 ip6 })
             <$> global6
+    orouter <- newOnionRouter
     atomically $ do
         let nobkts = R.defaultBucketCount :: Int
         tbl4 <- newTVar $ R.nullTable (comparing nodeId) (\s -> hashWithSalt s . nodeId) tentative_info4 nobkts
@@ -131,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
+        return $ Routing tentative_info sched4 tbl4 committee4 sched6 tbl6 committee6 orouter
 
 
 -- TODO: This should cover more cases
@@ -241,24 +244,25 @@ updateRouting client routing naddr msg = do
     hPutStrLn stderr $ "updateRouting "++show (typ,tid)
     -- TODO: check msg type
     case prefer4or6 naddr Nothing of
-        Want_IP4 -> updateTable client naddr (routing4 routing) (committee4 routing) (sched4 routing)
-        Want_IP6 -> updateTable client naddr (routing6 routing) (committee6 routing) (sched6 routing)
+        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)
 
-updateTable :: Client -> NodeInfo -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO ()
-updateTable client naddr tbl committee sched = do
+updateTable :: Client -> NodeInfo -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TriadCommittee NodeId SockAddr -> TVar (Int.PSQ POSIXTime) -> IO ()
+updateTable client naddr orouter tbl committee sched = do
         self <- atomically $ R.thisNode <$> readTVar tbl
         when (nodeIP self /= nodeIP naddr) $ do
             -- TODO: IP address vote?
-            insertNode (toxKademlia client committee tbl sched) naddr
+            insertNode (toxKademlia client committee orouter tbl sched) naddr
 
-toxKademlia :: Client -> TriadCommittee NodeId SockAddr -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo
-toxKademlia client committee var sched
+toxKademlia :: Client -> TriadCommittee NodeId SockAddr -> OnionRouter -> TVar (R.BucketList NodeInfo) -> TVar (Int.PSQ POSIXTime) -> Kademlia NodeId NodeInfo
+toxKademlia client committee orouter var sched
     = Kademlia quietInsertions
                toxSpace
                (vanillaIO var $ ping client)
                    { tblTransition = \tr -> do
                         io1 <- transitionCommittee committee tr
                         io2 <- touchBucket toxSpace (15*60) var sched tr
+                        hookBucketList orouter tr
                         return $ do
                             io1 >> io2
                             {-
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs
index d441dc0a..d4e1a754 100644
--- a/src/Network/Tox/Transport.hs
+++ b/src/Network/Tox/Transport.hs
@@ -13,28 +13,22 @@ import Crypto.Tox
 import Network.Tox.DHT.Transport
 import Network.Tox.Onion.Transport
 import Network.Tox.Crypto.Transport
+import OnionRouter
 
 import Network.Socket
 
-type RouteId = () -- todo
-
-lookupSender :: SockAddr -> Nonce8 -> IO (Maybe (NodeInfo, RouteId))
-lookupSender _ _ = return Nothing -- todo
-
-lookupRoute :: NodeInfo -> RouteId -> IO (Maybe OnionRoute)
-lookupRoute _ _ = return Nothing -- todo
-
 toxTransport ::
       TransportCrypto
+          -> OnionRouter
           -> (PublicKey -> IO (Maybe NodeInfo))
           -> UDPTransport
           -> IO ( Transport String NodeInfo (DHTMessage Encrypted8)
                 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
                 , Transport String SockAddr NetCrypto )
-toxTransport crypto closeLookup udp = do
+toxTransport crypto orouter closeLookup udp = do
     (dht,udp1) <- partitionTransport parseDHTAddr (Just . encodeDHTAddr) $ forwardOnions crypto udp
-    (onion,udp2) <- partitionTransportM (parseOnionAddr lookupSender)
-                                        (encodeOnionAddr lookupRoute)
+    (onion,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter)
+                                        (encodeOnionAddr $ lookupRoute orouter)
                                         udp1
     let netcrypto = layerTransport parseNetCrypto encodeNetCrypto udp2
     return ( forwardDHTRequests crypto closeLookup dht