1 files changed, 44 insertions, 13 deletions

diff --git a/OnionRouter.hs b/OnionRouter.hs
index bbc9ad8f..5f66dc68 100644
--- a/OnionRouter.hs
+++ b/OnionRouter.hs
@@ -12,7 +12,8 @@ import Network.Kademlia.Routing as R
 import Network.Kademlia.Search
 import Network.QueryResponse
 import Network.Tox.NodeId
-import Network.Tox.Onion.Transport
+import Network.Tox.Onion.Transport as Onion
+import qualified Data.Tox.Relay as TCP
 import qualified Network.Tox.TCP as TCP
 import qualified TCPProber as TCP
 
@@ -26,6 +27,7 @@ import Data.Bits
 import Data.Bool
 import Data.List
 import qualified Data.ByteString     as B
+import Data.Functor.Identity
 import Data.Hashable
 import qualified Data.HashMap.Strict as HashMap
          ;import Data.HashMap.Strict (HashMap)
@@ -147,11 +149,27 @@ gotTimeout rr = rr
 
 newtype RouteEvent = BuildRoute RouteId
 
-newOnionRouter :: TransportCrypto -> (String -> IO ()) -> IO OnionRouter
+newOnionRouter :: TransportCrypto
+                    -> (String -> IO ())
+                    -> IO ( OnionRouter
+                          , TVar ( ChaChaDRG
+                                 , Word64Map (Either (MVar TCP.RelayPacket)
+                                                     (MVar (OnionMessage Identity)))))
 newOnionRouter crypto perror = do
     drg0 <- drgNew
-    (tbl,tcp) <- do
-        client <- TCP.newClient crypto
+    (rlog,pq) <- atomically $ (,) <$> newTChan <*> newTVar W64.empty
+    ((tbl,tcptbl),tcp) <- do
+        (tcptbl, client) <- TCP.newClient crypto Left $ \case
+            Left v  -> void . tryPutMVar v
+            Right v -> \case
+                TCP.OnionPacketResponse x@(OnionAnnounceResponse n8 n24 _) -> do
+                    mod <- lookupSender' pq rlog localhost4 n8
+                    forM_ mod $ \od -> do
+                        Onion.decrypt crypto x od >>= \case
+                            Right (y,_) -> void $ tryPutMVar v y
+                            _           -> return ()
+                _ -> return ()
+
         let addr = SockAddrInet 0 0
             tentative_udp = NodeInfo
                 { nodeId   = key2id $ transportPublic crypto
@@ -164,7 +182,7 @@ newOnionRouter crypto perror = do
                                         (\s -> hashWithSalt s . TCP.nodeId)
                                         tentative_info
                                         R.defaultBucketCount
-        return $ (,) tbl TCP.TCPClient
+        return $ (,) (tbl,tcptbl) TCP.TCPClient
             { tcpCrypto     = crypto
             , tcpClient     = client
             , tcpGetGateway = selectGateway tbl
@@ -173,7 +191,6 @@ newOnionRouter crypto perror = do
         -- chan <- newTChan
         drg <- newTVar drg0
         -- forM_ [0..11] $ \n -> writeTChan chan $ BuildRoute (RouteId n)
-        pq <- newTVar W64.empty
         rm <- newArray (0,11) Nothing
         tn <- newTVar IntMap.empty
         ti <- newTVar HashMap.empty
@@ -182,7 +199,6 @@ newOnionRouter crypto perror = do
         tti <- newTVar HashMap.empty
         ttc <- newTVar 0
         pr <- newArray (0,11) 0
-        rlog <- newTChan
         prober <- TCP.newProber
         refresher <- newBucketRefresher
                             tbl
@@ -223,7 +239,7 @@ newOnionRouter crypto perror = do
                 , routeLogger        = perror
                 }
         return o
-    return or
+    return (or,tcptbl)
 
 updateTCP :: OnionRouter -> TCP.NodeInfo -> p -> IO ()
 updateTCP or addr x =
@@ -448,6 +464,7 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                 return $ do
                     myThreadId >>= flip labelThread ("OnionRouter.sendqs")
                     let Right ts = mts
+                        mtcpport = Nothing -- TODO
                     nodes <- case ts of
                         [_,_,_] -> sendqs
                         _       -> return []
@@ -469,9 +486,15 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                                 , routeNodeA = a
                                 , routeNodeB = b
                                 , routeNodeC = c
+                                , routeRelayPort = mtcpport
                                 }
                         [a,b,c] -> do
-                            atomically $ writeTChan (routeLog or) $ unwords [ "ONION Discarding insecure route:", show $ nodeAddr a, show $ nodeAddr b, show $ nodeAddr c]
+                            atomically $ writeTChan (routeLog or)
+                                       $ unwords [ "ONION Discarding insecure route:"
+                                                 , show $ nodeAddr a
+                                                 , show $ nodeAddr b
+                                                 , show $ nodeAddr c
+                                                 ]
                             return Nothing
                         _ -> return Nothing
         writeTVar (onionDRG or) drg'
@@ -484,17 +507,25 @@ handleEvent getnodes or e@(BuildRoute (RouteId rid)) = do
                                  v <- routeVersion . fromJust <$> readArray (routeMap or) rid
                                  writeArray (pendingRoutes or) rid v
                                  )
-                       mb
+                       (mb :: Maybe OnionRoute)
     case mb of
         Just _  -> routeLogger or $ "ONION Finished RouteId " ++ show rid
         Nothing -> routeLogger or $ "ONION Failed RouteId " ++ show rid
 
+
 lookupSender :: OnionRouter -> SockAddr -> Nonce8 -> IO (Maybe (OnionDestination RouteId))
-lookupSender or saddr (Nonce8 w8) = do
+lookupSender or = lookupSender' (pendingQueries or) (routeLog or)
+
+lookupSender' :: TVar (Word64Map PendingQuery)
+                       -> TChan String
+                       -> SockAddr
+                       -> Nonce8
+                       -> IO (Maybe (OnionDestination RouteId))
+lookupSender' pending log saddr (Nonce8 w8) = do
     result <- atomically $ do
-        ks <- readTVar (pendingQueries or)
+        ks <- readTVar pending
         let r = W64.lookup w8 ks
-        writeTChan (routeLog or) $ "ONION lookupSender " ++ unwords [show w8, "->", show r]
+        writeTChan log $ "ONION lookupSender " ++ unwords [show w8, "->", show r]
         return r
     return $ do
         od <- result