Moved resolving duty to Connection manager.

1 files changed, 19 insertions, 5 deletions

diff --git a/ToxManager.hs b/ToxManager.hs
index 78049010..2aeff620 100644
--- a/ToxManager.hs
+++ b/ToxManager.hs
@@ -9,6 +9,7 @@ module ToxManager where
 import Announcer
 import Announcer.Tox
 import ClientState
+import Control.Arrow
 import Control.Concurrent.STM
 import Control.Monad
 import Crypto.Tox
@@ -57,6 +58,7 @@ import GHC.Conc                  (labelThread)
 #endif
 import GHC.Conc                  (unsafeIOToSTM)
 import Connection
+import Connection.Tcp (TCPStatus)
 
 
 toxAnnounceSendData :: Tox.Tox JabberClients
@@ -91,7 +93,7 @@ toxman :: TVar (Map.Map Uniq24 AggregateSession)
             -> Announcer
             -> [(String,TVar (BucketList Tox.NodeInfo))]
             -> Tox.Tox JabberClients
-            -> PresenceState
+            -> PresenceState TCPStatus
             -> ToxManager ClientAddress
 toxman ssvar announcer toxbkts tox presence = ToxManager
     { activateAccount        = \k pubname seckey -> do
@@ -197,6 +199,18 @@ toxman ssvar announcer toxbkts tox presence = ToxManager
      , stringToKey = stringToKey_
      , showProgress = show
      , showKey = show
+     , resolvePeer = \(ToxContact me them) -> do
+            let mek   = id2key me
+                themk = id2key them
+            u <- xor24 <$> hash24 mek <*> hash24 themk
+            return [uniqueAsKey u]
+     , reverseAddress = \paddr -> atomically $ do
+        -- This will only succeed if there is an established session.
+        -- TODO: Is that sufficient?
+        ss <- readTVar ssvar
+        m <- forM (keyAsUnique paddr >>= (`Map.lookup` ss)) $ \c -> do
+            fmap (uncurry ToxContact . (key2id *** key2id)) <$> compatibleKeys c
+        return $ maybeToList (join m)
      }
     , resolveToxPeer = \me them -> do
         let m = do meid <- readMaybe $ T.unpack me
@@ -204,7 +218,7 @@ toxman ssvar announcer toxbkts tox presence = ToxManager
                    return (id2key meid, id2key themid)
         forM m $ \(me,them) -> do
             u <- xor24 <$> hash24 me <*> hash24 them
-            return $ addrToPeerKey $ Remote $ uniqueAsKey u
+            return $ addrToPeerKey $ Remote $ peerAddress $ uniqueAsKey u
     }
 
 key2jid :: Word32 -> PublicKey -> Text
@@ -231,7 +245,7 @@ initPerClient = do
 data ToxToXMPP = ToxToXMPP
     { txAnnouncer      :: Announcer
     , txAccount        :: Account JabberClients
-    , txPresence       :: PresenceState
+    , txPresence       :: PresenceState TCPStatus
     , txTox            :: Tox JabberClients
     , txSessions       :: TVar (Map.Map Uniq24 AggregateSession)
     }
@@ -510,7 +524,7 @@ akeyConnect announcer me them =
 -- | Returns a list of nospam values to use for friend requests to send to a
 -- remote peer.  This list is non-empty only when it is desirable to send
 -- friend requests.
-checkSoliciting :: PresenceState -> PublicKey -> PublicKey -> Contact -> IO [NoSpam]
+checkSoliciting :: PresenceState TCPStatus -> PublicKey -> PublicKey -> Contact -> IO [NoSpam]
 checkSoliciting presence me them contact = do
     let theirhost = T.pack $ show (key2id them) ++ ".tox"
         myhost = T.pack $ show (key2id me) ++ ".tox"
@@ -616,7 +630,7 @@ stopConnecting ToxToXMPP{txAnnouncer=announcer,txAccount=acnt} them reason = do
     cancel announcer akeyD
 
 forkAccountWatcher :: TVar (Map.Map Uniq24 AggregateSession)
-                      -> Account JabberClients -> Tox JabberClients -> PresenceState -> Announcer -> IO ThreadId
+                      -> Account JabberClients -> Tox JabberClients -> PresenceState TCPStatus -> Announcer -> IO ThreadId
 forkAccountWatcher ssvar acc tox st announcer = forkIO $ do
     myThreadId >>= flip labelThread ("online:"
                                       ++ show (key2id $ toPublic $ userSecret acc))