Added tox-id annotation to tox peer connections.

1 files changed, 16 insertions, 5 deletions

diff --git a/Presence/XMPPServer.hs b/Presence/XMPPServer.hs
index 1de6a26a..49cfbb95 100644
--- a/Presence/XMPPServer.hs
+++ b/Presence/XMPPServer.hs
@@ -1254,8 +1254,9 @@ forkConnection :: Server SockAddr ConnectionData releaseKey XML.Event
                 -> Sink (Flush XML.Event) IO ()
                 -> TChan Stanza
                 ->  IO (TChan Stanza)
-forkConnection sv xmpp saddr (ConnectionData auxAddr _) pingflag src snk stanzas = do
-    let clientOrServer@(namespace,tellmyname,telltheirname,_) = case auxAddr of
+forkConnection sv xmpp saddr cdta pingflag src snk stanzas = do
+    let auxAddr = cdAddr cdta
+        clientOrServer@(namespace,tellmyname,telltheirname,_) = case auxAddr of
             Right _    -> ("jabber:client", xmppTellMyNameToClient xmpp (ClientAddress saddr)
                                           , xmppTellClientHisName xmpp (ClientAddress saddr)
                                           , ClientOrigin (ClientAddress saddr))
@@ -1414,13 +1415,19 @@ peerKey bind_addr sock = do
              else return laddr     -- Weird hack: addr is would-be peer name
     -- Assume remote peers are listening on the same port that we do.
     let peerport = fromIntegral $ fromMaybe 5269 $ bind_addr >>= sockAddrPort
-    return $ (raddr `withPort` peerport,ConnectionData (Left (Local laddr)) XMPP)
+    return $ ( raddr `withPort` peerport
+             , ConnectionData { cdAddr    = Left (Local laddr)
+                              , cdType    = XMPP
+                              , cdProfile = "." } )
 
 clientKey :: SocketLike sock => sock -> IO (SockAddr,ConnectionData)
 clientKey sock = do
     laddr <- getSocketName sock
     raddr <- getPeerName sock
-    return $ (laddr,ConnectionData (Right (Remote raddr)) XMPP)
+    return $ ( laddr
+             , ConnectionData { cdAddr    = Right (Remote raddr)
+                              , cdType    = XMPP
+                              , cdProfile = "." } )
 
 xmlifyRosterItems :: Monad m => Set Text -> Text -> Set Text -> ConduitM i Event m ()
 xmlifyRosterItems solicited stype set = mapM_ item (Set.toList set)
@@ -1830,7 +1837,11 @@ data ConnectionType = XMPP | Tox
 data ConnectionData = ConnectionData
     { cdAddr :: Either (Local SockAddr)  -- Peer connection local address
                        (Remote SockAddr) -- Client connection remote address
-    , cdType :: ConnectionType
+    , cdType    :: ConnectionType
+    , cdProfile :: Text -- Currently ignored for clients.  Instead, see
+                        -- 'clientProfile' field of 'ClientState'.
+                        --
+                        -- For peers: "." for XMPP, otherwise the ".tox" hostname.
     }
     deriving (Eq,Ord,Show)