1 files changed, 27 insertions, 12 deletions

diff --git a/dht/Presence/Presence.hs b/dht/Presence/Presence.hs
index 866aad78..c54c3659 100644
--- a/dht/Presence/Presence.hs
+++ b/dht/Presence/Presence.hs
@@ -13,6 +13,7 @@ import Control.Concurrent
 import Control.Concurrent.Lifted.Instrument
 #endif
 
+import Control.Arrow
 import Control.Concurrent.STM
 import Control.Monad.Trans
 import Network.Socket ( SockAddr(..) )
@@ -133,17 +134,21 @@ newPresenceState cw toxman sv man = atomically $ do
         return $ st { toxManager = fmap ($ st) toxman }
 
 
-nameForClient :: PresenceState stat -> ClientAddress -> IO Text
-nameForClient state k = do
+nameForClient' :: PresenceState stat -> Maybe Text -> Maybe Text -> ClientAddress -> IO Text
+nameForClient' state mbNameForMe mbTheirName k = do
     mc <- atomically $ do
         cmap <- readTVar (clients state)
         return $ Map.lookup k cmap
     case mc of
-        Nothing -> textHostName
+        Nothing -> textHostName -- TODO: We can use mbNameForMe to initialize the clientProfile
         Just client -> case clientProfile client of
             "."     -> textHostName
             profile -> return profile
 
+nameForClient :: PresenceState stat -> ClientAddress -> IO Text
+nameForClient state k = nameForClient' state Nothing Nothing k
+
+
 presenceHooks :: PresenceState stat -> Map Text MUC
                                       -> Int
                                       -> Maybe SockAddr -- ^ client-to-server bind address
@@ -152,7 +157,7 @@ presenceHooks :: PresenceState stat -> Map Text MUC
 presenceHooks state chats verbosity mclient mpeer = XMPPServerParameters
     { xmppChooseResourceName        = chooseResourceName state
     , xmppTellClientHisName         = tellClientHisName state
-    , xmppTellMyNameToClient        = nameForClient state
+    , xmppTellMyNameToClient        = nameForClient' state
     , xmppTellMyNameToPeer          = \(Local addr) -> return $ addrToText addr
     , xmppTellPeerHisName           = return . peerKeyToText
     , xmppNewConnection             = newConn state
@@ -726,8 +731,12 @@ deliverMessage state fail msg =
         fromMaybe (do dput XJabber $ "Unknown peer " ++ show senderk
                       fail)
                 $ Map.lookup senderk pchans
-            <&> \(Conn { connChan = sender_chan
-                       , auxData  = ConnectionData (Left laddr) ctyp cprof _ }) -> do
+            <&> \Conn { connChan = sender_chan
+                      , auxData  = ConnectionData { cdAddr    = Left laddr
+                                                  , cdType    = ctyp
+                                                  , cdProfile = cprof
+                                                  }
+                      } -> do
         fromMaybe (do dput XJabber $ "Message missing \"to\" attribute."
                       fail)
                 $ (stanzaTo msg) <&> \to -> do
@@ -916,9 +925,7 @@ informPeerPresence state k stanza = do
     dput XJabber $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
     (ctyp,cprof) <- atomically $ do
         mconn <- Map.lookup k <$> readTVar (pkeyToChan state)
-        return $ fromMaybe (XMPP,".") $ do
-            ConnectionData _ ctyp cprof _ <- auxData <$> mconn
-            return (ctyp,cprof)
+        return $ fromMaybe (XMPP,".") $ (cdType &&& cdProfile) . auxData <$> mconn
     forM_ clients $ \(ck,con,client) -> do
         -- (TODO: appropriately authorized clients only.)
         -- For now, all "available" clients (available = sent initial presence)
@@ -1263,7 +1270,11 @@ peerSubscriptionRequest state fail k stanza chan = do
         cmap <- readTVar (clients state)
         return (pktc,cktc,cmap)
     fromMaybe fail $ (Map.lookup k pktc)
-        <&> \Conn { auxData=ConnectionData (Left laddr) ctyp profile _ } -> do
+        <&> \Conn { auxData = ConnectionData { cdAddr    = Left laddr
+                                             , cdType    = ctyp
+                                             , cdProfile = profile
+                                             }
+                  } -> do
     (mine,totup) <- case (ctyp,profile) of
         (Tox,p) -> let (u,h,r) = splitJID to
                    in return ( h == p, (u,h,r) )
@@ -1412,8 +1423,12 @@ peerInformSubscription state fail k stanza = do
         cmap <- readTVar (clients state)
         return (pktc,cktc,cmap)
     fromMaybe fail $ Map.lookup k ktc
-        <&> \(Conn { connChan=sender_chan
-                   , auxData =ConnectionData (Left laddr) ctyp profile _ }) -> do
+        <&> \Conn { connChan = sender_chan
+                  , auxData = ConnectionData { cdAddr    = Left laddr
+                                             , cdType    = ctyp
+                                             , cdProfile = profile }
+                  } -> do
+
     let man = manager state profile
     (from_u,from_h,_) <- case ctyp of
         Tox  -> return $ splitJID from