Fixed decryption of cookies via TCP.

2 files changed, 18 insertions, 11 deletions

diff --git a/dht/src/Network/Tox/DHT/Transport.hs b/dht/src/Network/Tox/DHT/Transport.hs
index ed755880..5de92916 100644
--- a/dht/src/Network/Tox/DHT/Transport.hs
+++ b/dht/src/Network/Tox/DHT/Transport.hs
@@ -59,6 +59,8 @@ import Data.Tuple
 import Data.Word
 import GHC.Generics
 import Network.Socket
+import DPut
+import DebugTag
 
 type DHTTransport ni = Transport String ni (DHTMessage Encrypted8)
 type HandleHi ni a = Arrival String ni (DHTMessage Encrypted8) -> IO a
@@ -97,8 +99,8 @@ mapMessage f (DHTLanDiscovery nid)     = Nothing
 instance Sized Ping where size = ConstSize 1
 instance Sized Pong where size = ConstSize 1
 
-parseDHTAddr :: Eq saddr =>
-                    STM [(saddr, (Int, PublicKey))]
+parseDHTAddr :: (Eq saddr, Show ni) =>
+                    (saddr -> STM (Maybe ni))
                     -> (NodeId -> saddr -> Either String ni)
                     -> (ByteString, saddr)
                     -> IO (Either (DHTMessage Encrypted8,ni) (ByteString,saddr))
@@ -113,10 +115,9 @@ parseDHTAddr pendingCookies nodeInfo (msg,saddr)
     0x04 -> left $ direct nodeInfo bs saddr DHTSendNodes
     0x18 -> left $ direct nodeInfo bs saddr DHTCookieRequest
     0x19 -> do
-        cs <- atomically pendingCookies
-        let ni = fromMaybe (noReplyAddr nodeInfo saddr) $ do
-                    (cnt,key) <- lookup saddr cs <|> listToMaybe (map snd cs)
-                    either (const Nothing) Just $ nodeInfo (key2id key) saddr
+        mni <- atomically $ pendingCookies saddr
+        let ni = fromMaybe (noReplyAddr nodeInfo saddr) mni
+        dput XMan $ "Got encrypted cookie! mni="++show mni
         left $ fanGet bs getCookie (uncurry DHTCookie) (const $ ni)
     0x20 -> left $ fanGet bs getDHTReqest (uncurry DHTDHTRequest) (asymNodeInfo nodeInfo saddr . snd)
     0x21 -> left $ do
diff --git a/dht/src/Network/Tox/Transport.hs b/dht/src/Network/Tox/Transport.hs
index b017f7be..e90917f6 100644
--- a/dht/src/Network/Tox/Transport.hs
+++ b/dht/src/Network/Tox/Transport.hs
@@ -18,18 +18,24 @@ import Network.Tox.Onion.Transport
 import Network.Tox.Crypto.Transport
 import Network.Tox.Onion.Routes
 
+import Control.Applicative
 import Control.Concurrent.STM
 import qualified Data.ByteString    as B
 import qualified Data.Dependent.Map as DMap
 import Data.Dependent.Sum
 import Data.Functor.Identity
+import Data.Maybe
 import Network.Socket
 
-pendingCookiesUDP :: TransportCrypto -> STM [(SockAddr, (Int, PublicKey))]
-pendingCookiesUDP crypto = readTVar $ pendingCookies crypto
+pendingCookiesUDP :: TransportCrypto -> SockAddr -> STM (Maybe UDP.NodeInfo)
+pendingCookiesUDP crypto saddr = do
+    cs <- readTVar $ pendingCookies crypto
+    return $ do
+        (_,key) <- lookup saddr cs <|> listToMaybe (map snd cs)
+        either (const Nothing) Just $ nodeInfo (key2id key) saddr
 
-pendingCookiesTCP :: TransportCrypto -> STM [(ViaRelay, (Int, PublicKey))]
-pendingCookiesTCP crypto = return [] -- TODO
+pendingCookiesTCP :: ViaRelay -> STM (Maybe ViaRelay)
+pendingCookiesTCP ni = return $ Just ni
 
 toxTransport ::
       TransportCrypto
@@ -52,7 +58,7 @@ toxTransport crypto orouter closeLookup addr udp relaynet _ tcp2client = do
     -- rlynet0 = layerTransportM (DHT.decrypt crypto Multi.relayNodeId) (DHT.encrypt crypto Multi.relayNodeId) relaynet
     (netcryptoTCP, relaynet0) <- partitionTransport parseCrypto encodeCrypto relaynet
     (dhtTCP,relaynet1) <- partitionTransportM
-                            (parseDHTAddr (pendingCookiesTCP crypto) (\nid viarelay -> Right viarelay))
+                            (parseDHTAddr pendingCookiesTCP (\nid viarelay -> Right viarelay))
                             (fmap Just . encodeDHTAddr id)
                             relaynet0
     let _ = dhtTCP :: Transport String ViaRelay (DHTMessage Encrypted8)