XMPP: Type-checking on various uses of SockAddr.

1 files changed, 206 insertions, 183 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index af6597b6..244bbead 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -53,11 +53,13 @@ import Network.Tox.NodeId (key2id)
 import Crypto.Tox (decodeSecret)
 import DPut
 
-isPeerKey :: ConnectionKey -> Bool
+{-
+isPeerKey :: ClientAddress -> Bool
 isPeerKey k = case k of { PeerKey {} -> True ; _ -> False }
 
-isClientKey :: ConnectionKey -> Bool
+isClientKey :: ClientAddress -> Bool
 isClientKey k = case k of { ClientKey {} -> True ; _ -> False }
+-}
 
 localJID :: Text -> Text -> Text -> IO Text
 localJID user "." resource = do
@@ -86,20 +88,21 @@ data ToxManager k = ToxManager
     }
 
 data PresenceState = forall status. PresenceState
-    { clients         :: TVar (Map ConnectionKey ClientState)
+    { clients         :: TVar (Map ClientAddress ClientState)
     , clientsByUser   :: TVar (Map Text LocalPresence)
     , clientsByProfile :: TVar (Map Text LocalPresence)
-    , remotesByPeer   :: TVar (Map ConnectionKey
+    , remotesByPeer   :: TVar (Map PeerAddress
                                    (Map UserName RemotePresence))
     , server          :: TMVar (XMPPServer, Connection.Manager status Text)
-    , keyToChan       :: TVar (Map ConnectionKey Conn)
+    , ckeyToChan       :: TVar (Map ClientAddress Conn)
+    , pkeyToChan       :: TVar (Map PeerAddress Conn)
     , consoleWriter   :: Maybe ConsoleWriter
-    , toxManager      :: Maybe (ToxManager ConnectionKey)
+    , toxManager      :: Maybe (ToxManager ClientAddress)
     }
 
 
 newPresenceState :: Maybe ConsoleWriter
-                 -> Maybe (PresenceState -> ToxManager ConnectionKey)
+                 -> Maybe (PresenceState -> ToxManager ClientAddress)
                  -> TMVar (XMPPServer, Connection.Manager status Text)
                  -> IO PresenceState
 newPresenceState cw toxman xmpp = atomically $ do
@@ -107,13 +110,15 @@ newPresenceState cw toxman xmpp = atomically $ do
         clientsByUser    <- newTVar Map.empty
         clientsByProfile <- newTVar Map.empty
         remotesByPeer    <- newTVar Map.empty
-        keyToChan        <- newTVar Map.empty
+        ckeyToChan       <- newTVar Map.empty
+        pkeyToChan       <- newTVar Map.empty
         let st = PresenceState
                     { clients          = clients
                     , clientsByUser    = clientsByUser
                     , clientsByProfile = clientsByProfile
                     , remotesByPeer    = remotesByPeer
-                    , keyToChan        = keyToChan
+                    , ckeyToChan       = ckeyToChan
+                    , pkeyToChan       = pkeyToChan
                     , server           = xmpp
                     , consoleWriter    = cw
                     , toxManager       = Nothing
@@ -121,7 +126,7 @@ newPresenceState cw toxman xmpp = atomically $ do
         return $ st { toxManager = fmap ($ st) toxman }
 
 
-nameForClient :: PresenceState -> ConnectionKey -> IO Text
+nameForClient :: PresenceState -> ClientAddress -> IO Text
 nameForClient state k = do
     mc <- atomically $ do
         cmap <- readTVar (clients state)
@@ -139,9 +144,8 @@ presenceHooks state verbosity mclient mpeer = XMPPServerParameters
     { xmppChooseResourceName        = chooseResourceName state
     , xmppTellClientHisName         = tellClientHisName state
     , xmppTellMyNameToClient        = nameForClient state
-    , xmppTellMyNameToPeer          = \addr -> return $ addrToText addr
+    , xmppTellMyNameToPeer          = \(Local addr) -> return $ addrToText addr
     , xmppTellPeerHisName           = return . peerKeyToText
-    , xmppTellClientNameOfPeer      = flip peerKeyToResolvedName
     , xmppNewConnection             = newConn state
     , xmppEOF                       = eofConn state
     , xmppRosterBuddies             = rosterGetBuddies state
@@ -164,7 +168,7 @@ presenceHooks state verbosity mclient mpeer = XMPPServerParameters
 
 
 data LocalPresence = LocalPresence
-    { networkClients :: Map ConnectionKey ClientState
+    { networkClients :: Map ClientAddress ClientState
     -- TODO: loginClients
     }
 
@@ -177,18 +181,17 @@ data RemotePresence = RemotePresence
 
 
 
-pcSingletonNetworkClient :: ConnectionKey
-                          -> ClientState -> LocalPresence
+pcSingletonNetworkClient :: ClientAddress -> ClientState -> LocalPresence
 pcSingletonNetworkClient key client =
     LocalPresence
     { networkClients = Map.singleton key client
     }
 
-pcInsertNetworkClient :: ConnectionKey -> ClientState -> LocalPresence -> LocalPresence
+pcInsertNetworkClient :: ClientAddress -> ClientState -> LocalPresence -> LocalPresence
 pcInsertNetworkClient key client pc =
     pc { networkClients = Map.insert key client (networkClients pc) }
 
-pcRemoveNewtworkClient :: ConnectionKey
+pcRemoveNewtworkClient :: ClientAddress
                         -> LocalPresence -> Maybe LocalPresence
 pcRemoveNewtworkClient key pc = if pcIsEmpty pc' then Nothing
                                                  else Just pc'
@@ -215,8 +218,8 @@ identifyTTY' ttypids uid inode = ttypid
        textify (tty,pid) = (fmap lazyByteStringToText tty, pid)
 
 chooseResourceName :: PresenceState
-                    -> ConnectionKey -> SockAddr -> Maybe Text -> Maybe Text -> IO Text
-chooseResourceName state k addr clientsNameForMe desired = do
+                    -> ClientAddress -> Remote SockAddr -> Maybe Text -> Maybe Text -> IO Text
+chooseResourceName state k (Remote addr) clientsNameForMe desired = do
     muid <- getLocalPeerCred' addr
     (mtty,pid) <- getTTYandPID muid
     user <- getJabberUserForId muid
@@ -297,17 +300,17 @@ chooseResourceName state k addr clientsNameForMe desired = do
                         )
                    muid
 
--- Perform action with 'ClientState' associated with the given 'ConnectionKey'.
+-- Perform action with 'ClientState' associated with the given 'ClientAddress'.
 -- If there is no associated 'ClientState', then perform the supplied fallback
 -- action.
-forClient :: PresenceState -> ConnectionKey -> IO b -> (ClientState -> IO b) -> IO b
+forClient :: PresenceState -> ClientAddress -> IO b -> (ClientState -> IO b) -> IO b
 forClient state k fallback f = do
     mclient <- atomically $ do
         cs <- readTVar (clients state)
         return $ Map.lookup k cs
     maybe fallback f mclient
 
-tellClientHisName :: PresenceState -> ConnectionKey -> IO Text
+tellClientHisName :: PresenceState -> ClientAddress -> IO Text
 tellClientHisName state k = forClient state k fallback go
  where
     fallback  = localJID "nobody" "." "fallback"
@@ -316,14 +319,14 @@ tellClientHisName state k = forClient state k fallback go
 toMapUnit :: Ord k => [k] -> Map k ()
 toMapUnit xs = Map.fromList $ map (,()) xs
 
-resolveAllPeers :: [Text] -> IO (Map SockAddr ())
+resolveAllPeers :: [Text] -> IO (Map PeerAddress ())
 resolveAllPeers hosts = fmap (toMapUnit . concat) $ Prelude.mapM (fmap (take 1) . resolvePeer) hosts
 
 
 -- Read a roster file and start trying to connect to all relevent peers.
 rosterGetStuff
   :: (ConfigFiles.User -> ConfigFiles.Profile -> IO [L.ByteString])
-     -> PresenceState -> ConnectionKey -> IO [Text]
+     -> PresenceState -> ClientAddress -> IO [Text]
 rosterGetStuff what state k = forClient state k (return [])
     $ \client -> do
     jids <- configText what (clientUser client) (clientProfile client)
@@ -335,7 +338,7 @@ rosterGetStuff what state k = forClient state k (return [])
         -- Grok peers to associate with from the roster:
         forM_ hosts $ \host -> do
             -- We need either conns  :: Connection.Manager TCPStatus Text
-            --             or toxman :: ToxManager ConnectionKey
+            --             or toxman :: ToxManager ClientAddress
             -- It is decided by checking hostnames for .tox ending.
             let policySetter = fromMaybe (Connection.setPolicy conns host) $ do
                     toxman <- toxManager state
@@ -346,17 +349,17 @@ rosterGetStuff what state k = forClient state k (return [])
         atomically $ putTMVar svVar (sv,conns)
         return jids
 
-rosterGetBuddies :: PresenceState -> ConnectionKey -> IO [Text]
+rosterGetBuddies :: PresenceState -> ClientAddress -> IO [Text]
 rosterGetBuddies state k = rosterGetStuff ConfigFiles.getBuddies state k
 
-rosterGetSolicited :: PresenceState -> ConnectionKey -> IO [Text]
+rosterGetSolicited :: PresenceState -> ClientAddress -> IO [Text]
 rosterGetSolicited = rosterGetStuff ConfigFiles.getSolicited
 
 -- XXX: Should we be connecting to these peers?
-rosterGetOthers :: PresenceState -> ConnectionKey -> IO [Text]
+rosterGetOthers :: PresenceState -> ClientAddress -> IO [Text]
 rosterGetOthers = rosterGetStuff ConfigFiles.getOthers
 
-rosterGetSubscribers :: PresenceState -> ConnectionKey -> IO [Text]
+rosterGetSubscribers :: PresenceState -> ClientAddress -> IO [Text]
 rosterGetSubscribers = rosterGetStuff ConfigFiles.getSubscribers
 
 data Conn = Conn { connChan :: TChan Stanza
@@ -413,23 +416,20 @@ getBuddiesAndSolicited state pred
         -- of (Bool,Text) for processing outside.
         return (isbud,u,user,profile)
 
-sendProbesAndSolicitations :: PresenceState
-                            -> ConnectionKey -> SockAddr -> TChan Stanza -> IO ()
-sendProbesAndSolicitations state k laddr chan = do
+sendProbesAndSolicitations :: PresenceState -> PeerAddress -> Local SockAddr -> TChan Stanza -> IO ()
+sendProbesAndSolicitations state k (Local laddr) chan = do
     -- get all buddies & solicited matching k for all users
     xs <- getBuddiesAndSolicited state $ \case
         h | ".tox" `Text.isSuffixOf` h -> return False -- Tox probes/solicitations are handled in ToxToXMPP module.
         h -> do
             addrs <- nub `fmap` resolvePeer h
-            case k of
-                ClientKey _ -> return False            -- Solicitations and probes are only for peers.
-                PeerKey a   -> return $ a `elem` addrs -- Only for this peer /k/.
+            return $ k `elem` addrs -- Only for this peer /k/.
     forM_ xs $ \(isbud,u,user,profile) -> do
         let make = if isbud then presenceProbe
                             else presenceSolicitation
             toh = peerKeyToText k
             jid = unsplitJID (u,toh,Nothing)
-            me = addrToText laddr
+            me = addrToText laddr -- xmppTellMyNameToPeer
             from = if isbud then me -- probe from server
                             else -- solicitation from particular user
                                  unsplitJID (Just user,me,Nothing)
@@ -439,38 +439,35 @@ sendProbesAndSolicitations state k laddr chan = do
         atomically $ writeTChan chan stanza
     -- reverse xs `seq` return ()
 
-newConn :: PresenceState -> ConnectionKey -> ConnectionData -> TChan Stanza -> IO ()
-newConn state k cdta outchan = do
-    atomically $ modifyTVar' (keyToChan state)
-        $ Map.insert k Conn { connChan = outchan
-                            , auxData = cdta }
-    when (isPeerKey k)
-        $ sendProbesAndSolicitations state k (cdAddr cdta) outchan
+
+newConn :: PresenceState -> SockAddr -> ConnectionData -> TChan Stanza -> IO ()
+newConn state saddr cdta outchan =
+    case classifyConnection saddr cdta of
+        Left (pkey,laddr) -> do
+            atomically $ modifyTVar' (pkeyToChan state)
+                $ Map.insert pkey Conn { connChan = outchan
+                                       , auxData  = cdta }
+            sendProbesAndSolicitations state pkey laddr outchan
+        Right (ckey,_) -> do
+            atomically $ modifyTVar' (ckeyToChan state)
+                $ Map.insert ckey Conn { connChan = outchan
+                                       , auxData  = cdta }
 
 delclient :: (Alternative m, Monad m) =>
-           ConnectionKey -> m LocalPresence -> m LocalPresence
+           ClientAddress -> m LocalPresence -> m LocalPresence
 delclient k mlp = do
     lp <- mlp
     let nc = Map.delete k $ networkClients lp
     guard $ not (Map.null nc)
     return $ lp { networkClients = nc }
 
-eofConn :: PresenceState -> ConnectionKey -> IO ()
-eofConn state k = do
-    atomically $ modifyTVar' (keyToChan state) $ Map.delete k
-    case k of
-        ClientKey {} -> do
-            forClient state k (return ()) $ \client -> do
-            forM_ (toxManager state) $ \toxman -> do
-                case Text.splitAt 43 (clientProfile client) of
-                    (pub,".tox") -> deactivateAccount toxman k (clientProfile client)
-                    _            -> return ()
-            stanza <- makePresenceStanza "jabber:server" Nothing Offline
-            informClientPresence state k stanza
-            atomically $ do
-                modifyTVar' (clientsByUser    state) $ Map.alter (delclient k) (clientUser    client)
-                modifyTVar' (clientsByProfile state) $ Map.alter (delclient k) (clientProfile client)
-        PeerKey {} -> do
+eofConn :: PresenceState -> SockAddr -> ConnectionData -> IO ()
+eofConn state saddr cdta = do
+    atomically $ case classifyConnection saddr cdta of
+                    Left  (pkey,_) -> modifyTVar' (pkeyToChan state) $ Map.delete pkey
+                    Right (ckey,_) -> modifyTVar' (ckeyToChan state) $ Map.delete ckey
+    case classifyConnection saddr cdta of
+        Left (k,_) -> do
             let h = peerKeyToText k
             jids <- atomically $ do
                 rbp <- readTVar (remotesByPeer state)
@@ -482,29 +479,26 @@ eofConn state k = do
             forM_ jids $ \jid -> do
             stanza <- makePresenceStanza "jabber:client" (Just jid) Offline
             informPeerPresence state k stanza
+        Right (k,_) -> do
+            forClient state k (return ()) $ \client -> do
+            forM_ (toxManager state) $ \toxman -> do
+                case Text.splitAt 43 (clientProfile client) of
+                    (pub,".tox") -> deactivateAccount toxman k (clientProfile client)
+                    _            -> return ()
+            stanza <- makePresenceStanza "jabber:server" Nothing Offline
+            informClientPresence state k stanza
+            atomically $ do
+                modifyTVar' (clientsByUser    state) $ Map.alter (delclient k) (clientUser    client)
+                modifyTVar' (clientsByProfile state) $ Map.alter (delclient k) (clientProfile client)
 
--- | The given address is taken to be the local address for the socket this JID
--- came in on.  The returned JID parts are suitable for unsplitJID to create a
--- valid JID for communicating to a client.  The returned Bool is True when the
--- host part refers to this local host (i.e. it equals the given SockAddr).
--- If there are multiple results, it will prefer one which is a member of the
--- given list in the last argument.
-rewriteJIDForClient :: SockAddr -> Text -> [Text] -> IO (Bool,(Maybe Text,Text,Maybe Text))
-rewriteJIDForClient laddr jid buds = do
-    let (n,h,r) = splitJID jid
-    maddr <- parseAddress (strip_brackets h)
-    fromMaybe (return (False,(n,ip6literal h,r))) $ maddr <&> \addr -> do
-    let mine =  laddr `withPort` 0  == addr `withPort` 0
-    h' <- if mine then textHostName
-                  else peerKeyToResolvedName buds (PeerKey addr)
-    return (mine,(n,h',r))
+parseRemoteAddress :: Text -> IO (Maybe (Remote SockAddr))
+parseRemoteAddress s = fmap Remote <$> parseAddress s
 
 -- This attempts to reverse resolve a peers address to give the human-friendly
 -- domain name as it appears in the roster.  It prefers host names that occur
 -- in the given list of JIDs, but will fall back to any reverse-resolved name
 -- and if it was unable to reverse the address, it will yield an ip address.
-peerKeyToResolvedName :: [Text] -> ConnectionKey -> IO Text
-peerKeyToResolvedName buds k@(ClientKey { localAddress=addr }) = return "ErrorClIeNt1"
+peerKeyToResolvedName :: [Text] -> PeerAddress -> IO Text
 peerKeyToResolvedName buds pk = do
     ns <- peerKeyToResolvedNames pk
     let hs = map (\jid -> let (_,h,_)=splitJID jid in h) buds
@@ -512,27 +506,39 @@ peerKeyToResolvedName buds pk = do
     return $ fromMaybe (peerKeyToText pk) (listToMaybe ns')
 
 
+-- | The given address is taken to be the local address for the socket this JID
+-- came in on.  The returned JID parts are suitable for unsplitJID to create a
+-- valid JID for communicating to a client.  The returned Bool is True when the
+-- host part refers to this local host (i.e. it equals the given SockAddr).
+-- If there are multiple results, it will prefer one which is a member of the
+-- given list in the last argument.
+rewriteJIDForClient :: Local SockAddr -> Text -> [Text] -> IO (Bool,(Maybe Text,Text,Maybe Text))
+rewriteJIDForClient (Local laddr) jid buds = do
+    let (n,h,r) = splitJID jid
+    maddr <- parseAddress (strip_brackets h)
+    fromMaybe (return (False,(n,ip6literal h,r))) $ maddr <&> \saddr -> do
+    let mine =  sameAddress laddr saddr
+    h' <- if mine then textHostName
+                  else peerKeyToResolvedName buds (addrToPeerKey $ Remote saddr)
+    return (mine,(n,h',r))
+
 -- Given a local address and an IP-address JID, we return True if the JID is
 -- local, False otherwise.  Additionally, a list of equivalent hostname JIDS
 -- are returned.
-multiplyJIDForClient :: SockAddr -> Text -> IO (Bool,[(Maybe Text,Text,Maybe Text)])
-multiplyJIDForClient laddr jid = do
+multiplyJIDForClient :: ClientAddress -> Text -> IO (Bool,[(Maybe Text,Text,Maybe Text)])
+multiplyJIDForClient k jid = do
     let (n,h,r) = splitJID jid
     maddr <- parseAddress (strip_brackets h)
-    fromMaybe (return (False,[(n,ip6literal h,r)])) $ maddr <&> \addr -> do
-    let mine =  sameAddress laddr addr
+    fromMaybe (return (False,[(n,ip6literal h,r)])) $ maddr <&> \saddr -> do
+    let Local laddr = addrFromClientKey k
+        mine        = sameAddress laddr saddr
     names <- if mine then fmap (:[]) textHostName
-                     else peerKeyToResolvedNames (PeerKey addr)
+                     else peerKeyToResolvedNames (addrToPeerKey $ Remote saddr)
     return (mine,map (\h' -> (n,h',r)) names)
 
 
-addrTextToKey :: Text -> IO (Maybe ConnectionKey)
-addrTextToKey h = do
-    maddr <- parseAddress (strip_brackets h)
-    return (fmap PeerKey maddr)
-
-guardPortStrippedAddress :: Text -> SockAddr -> IO (Maybe ())
-guardPortStrippedAddress h laddr = do
+guardPortStrippedAddress :: Text -> Local SockAddr -> IO (Maybe ())
+guardPortStrippedAddress h (Local laddr) = do
     maddr <- fmap (fmap (`withPort` 0)) $ parseAddress (strip_brackets h)
     let laddr' = laddr `withPort` 0
     return $ maddr >>= guard . (==laddr')
@@ -541,15 +547,15 @@ guardPortStrippedAddress h laddr = do
 -- | Accepts a textual representation of a domainname
 -- JID suitable for client connections, and returns the
 -- coresponding ipv6 address JID suitable for peers paired
--- with a SockAddr with the address part of that JID in
+-- with a PeerAddress with the address part of that JID in
 -- binary form.  If no suitable address could be resolved
 -- for the given name, Nothing is returned.
-rewriteJIDForPeer :: Text -> IO (Maybe (Text,SockAddr))
+rewriteJIDForPeer :: Text -> IO (Maybe (Text,PeerAddress))
 rewriteJIDForPeer jid = do
     let (n,h,r) = splitJID jid
     maddr <- fmap listToMaybe $ resolvePeer h
     return $ flip fmap maddr $ \addr ->
-        let h' = addrToText addr
+        let h' = peerKeyToText addr
             to' = unsplitJID (n,h',r)
         in (to',addr)
 
@@ -567,14 +573,15 @@ deliverMessage :: PresenceState
                 -> IO ()
 deliverMessage state fail msg =
     case stanzaOrigin msg of
-      NetworkOrigin senderk@(ClientKey {}) _ -> do
+      ClientOrigin senderk _ -> do
         -- Case 1.  Client -> Peer
         mto <- fmap join $ mapM rewriteJIDForPeer (stanzaTo msg)
-        fromMaybe fail {- reverse lookup failure -} $ mto <&> \(to',addr) -> do
-        let k = PeerKey addr
-        chans <- atomically $ readTVar (keyToChan state)
-        fromMaybe fail $ (Map.lookup k chans) <&> \(Conn { connChan = chan
-                                                        , auxData = ConnectionData laddr ctyp }) -> do
+        fromMaybe fail {- reverse lookup failure -} $ mto <&> \(to',k) -> do
+        chans <- atomically $ readTVar (pkeyToChan state)
+        fromMaybe fail $ (Map.lookup k chans) <&> \Conn { connChan = chan
+                                                        , auxData = ConnectionData (Left (Local laddr))
+                                                                                   ctyp
+                                                        } -> do
         (n,r) <- forClient state senderk (return (Nothing,Nothing))
                         $ \c -> return (Just (clientUser c), Just (clientResource c))
         -- original 'from' address is discarded.
@@ -582,11 +589,14 @@ deliverMessage state fail msg =
         -- dup <- atomically $ cloneStanza (msg { stanzaTo=Just to', stanzaFrom=Just from' })
         let dup = (msg { stanzaTo=Just to', stanzaFrom=Just from' })
         sendModifiedStanzaToPeer dup chan
-      NetworkOrigin senderk@(PeerKey {}) _ -> do
-        key_to_chan <- atomically $ readTVar (keyToChan state)
-        fromMaybe fail $ (Map.lookup senderk key_to_chan)
+      PeerOrigin senderk _ -> do
+        (pchans,cchans) <- atomically $ do
+            pc <- readTVar (pkeyToChan state)
+            cc <- readTVar (ckeyToChan state)
+            return (pc,cc)
+        fromMaybe fail $ (Map.lookup senderk pchans)
             <&> \(Conn { connChan = sender_chan
-                       , auxData  = ConnectionData laddr ctyp }) -> do
+                       , auxData  = ConnectionData (Left laddr) ctyp }) -> do
         fromMaybe fail $ (stanzaTo msg) <&> \to -> do
         (mine,(n,h,r)) <- rewriteJIDForClient laddr to []
         if not mine then fail else do
@@ -600,7 +610,7 @@ deliverMessage state fail msg =
             let ks = Map.keys (networkClients presence_container)
                 chans = do
                     (k,client) <- Map.toList $ networkClients presence_container
-                    chan <- maybeToList $ Map.lookup k key_to_chan
+                    chan <- maybeToList $ Map.lookup k cchans
                     return (clientProfile client, clientUser client, chan)
             forM chans $ \(profile,user,chan) -> do
             buds <- configText ConfigFiles.getBuddies user profile
@@ -642,7 +652,7 @@ deliverMessage state fail msg =
                                       chan
 
 
-setClientFlag :: PresenceState -> ConnectionKey -> Int8 -> IO ()
+setClientFlag :: PresenceState -> ClientAddress -> Int8 -> IO ()
 setClientFlag state k flag =
     atomically $ do
         cmap <- readTVar (clients state)
@@ -653,12 +663,12 @@ setClientFlag0 :: ClientState -> Int8 -> STM ()
 setClientFlag0 client flag =
     modifyTVar' (clientFlags client) (\flgs -> flgs .|. flag)
 
-informSentRoster :: PresenceState -> ConnectionKey -> IO ()
+informSentRoster :: PresenceState -> ClientAddress -> IO ()
 informSentRoster state k = do
     setClientFlag state k cf_interested
 
 
-subscribedPeers :: Text -> Text -> IO [SockAddr]
+subscribedPeers :: Text -> Text -> IO [PeerAddress]
 subscribedPeers user profile = do
     jids <- configText ConfigFiles.getSubscribers user profile
     let hosts = map ((\(_,h,_)->h) . splitJID) jids
@@ -667,20 +677,23 @@ subscribedPeers user profile = do
 -- | this JID is suitable for peers, not clients.
 clientJID :: Conn -> ClientState -> Text
 clientJID con client = unsplitJID ( Just $ clientUser client
-                                  , addrToText $ cdAddr $ auxData con
+                                  , either (\(Local a) -> addrToText a) -- my host name, for peers
+                                           (error $ unlines [ "clientJID wrongly used for client connection!"
+                                                            , "TODO: my host name for clients? nameForClient? localJID?"])
+                                           $ cdAddr $ auxData con
                                   , Just $ clientResource client)
 
 -- | Send presence notification to subscribed peers.
 -- Note that a full JID from address will be added to the
 -- stanza if it is not present.
 informClientPresence :: PresenceState
-                        -> ConnectionKey -> StanzaWrap (LockedChan Event) -> IO ()
+                        -> ClientAddress -> StanzaWrap (LockedChan Event) -> IO ()
 informClientPresence state k stanza = do
     forClient state k (return ()) $ \client -> do
     informClientPresence0 state (Just k) client stanza
 
 informClientPresence0 :: PresenceState
-                       -> Maybe ConnectionKey
+                       -> Maybe ClientAddress
                        -> ClientState
                        -> StanzaWrap (LockedChan Event)
                        -> IO ()
@@ -692,8 +705,8 @@ informClientPresence0 state mbk client stanza = do
         atomically $ setClientFlag0 client cf_available
         maybe (return ()) (sendCachedPresence state) mbk
     addrs <- subscribedPeers (clientUser client) (clientProfile client)
-    ktc <- atomically $ readTVar (keyToChan state)
-    let connected = mapMaybe (flip Map.lookup ktc . PeerKey) addrs
+    ktc <- atomically $ readTVar (pkeyToChan state)
+    let connected = mapMaybe (flip Map.lookup ktc) addrs
     forM_ connected $ \con -> do
     let from' = clientJID con client
     mto <- runTraversableT $ do
@@ -706,7 +719,7 @@ informClientPresence0 state mbk client stanza = do
                              (connChan con)
 
 informPeerPresence :: PresenceState
-                    -> ConnectionKey
+                    -> PeerAddress
                     -> StanzaWrap (LockedChan Event)
                     -> IO ()
 informPeerPresence state k stanza = do
@@ -749,7 +762,7 @@ informPeerPresence state k stanza = do
 
         -- all clients, we'll filter available/authorized later
 
-        ktc <- readTVar (keyToChan state)
+        ktc <- readTVar (ckeyToChan state)
         runTraversableT $ do
         (ck,client) <- liftMT $ fmap Map.toList $ readTVar (clients state)
         con <- liftMaybe $ Map.lookup ck ktc
@@ -762,8 +775,7 @@ informPeerPresence state k stanza = do
         when is_avail $ do
         putStrLn $ "reversing for client: " ++ show from
         froms <- do -- flip (maybe $ return [from]) k . const $ do
-            let ClientKey laddr = ck
-            (_,trip) <- multiplyJIDForClient laddr from
+            (_,trip) <- multiplyJIDForClient ck from
             return (map unsplitJID trip)
 
         putStrLn $ "sending to client: " ++ show (stanzaType stanza,froms)
@@ -777,35 +789,37 @@ consoleClients PresenceState{ consoleWriter = Just cw } = readTVar (cwClients cw
 consoleClients _                                        = return Map.empty
 
 
-answerProbe :: PresenceState
-             -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO ()
+answerProbe :: PresenceState -> Maybe Text -> PeerAddress -> TChan Stanza -> IO ()
 answerProbe state mto k chan = do
     -- putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
-    (ktc,cmap) <- atomically $ (,) <$> readTVar (keyToChan state)
-                                   <*> readTVar (clients state)
+    ktc <- atomically $ readTVar (pkeyToChan state)
     muser <- runTraversableT $ do
         to <- liftT $ mto
         conn <- liftT $ Map.lookup k ktc
         let (mu,h,_) = splitJID to -- TODO: currently resource-id is ignored on presence
                                    --  probes.  Is this correct? Check the spec.
-        liftMT $ guardPortStrippedAddress h (cdAddr $ auxData conn)
+            Left laddr = cdAddr $ auxData conn
+        liftMT $ guardPortStrippedAddress h laddr
         u <- liftT mu
-        let ch      = addrToText (cdAddr $ auxData conn)
-            profile = fromMaybe "." $ clientProfile <$> Map.lookup k cmap
-        return (u,profile,conn,ch)
+        -- ORIG let ch = addrToText (auxAddr conn)
+        -- ORIG return (u,conn,ch)
+        let ch      = addrToText a where Local a = laddr
+        return (u,conn,ch)
 
-    forM_ muser $ \(u,profile,conn,ch) -> do
+    forM_ muser $ \(u,conn,ch) -> do
 
+    profiles <- releventProfiles (cdType $ auxData conn) u
+    forM_ profiles $ \profile -> do
+
+    -- only subscribed peers should get probe replies
     resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u profile
-    let gaddrs = groupBy (\a b -> snd a == snd b) (sort resolved_subs)
+    let gaddrs = groupBy sameHost (sort resolved_subs)
+        sameHost a b = (snd a == snd b) -- (==) `on` snd
         whitelist = do
-            xs <- gaddrs
-            x <- take 1 xs
-            guard $ snd x==k
-            mapMaybe fst xs
-
-    -- -- only subscribed peers should get probe replies
-    -- addrs <- subscribedPeers u
+            xs <- gaddrs     -- group of subscribed jids on the same host
+            x <- take 1 xs   -- the host from the group
+            guard $ snd x==k -- only hosts matching the key /k/
+            mapMaybe fst xs  -- all users subscribed at the remote peer /k/
 
     -- TODO: notify remote peer that they are unsubscribed?
     --   reply <- makeInformSubscription "jabber:server" to from False
@@ -838,16 +852,15 @@ answerProbe state mto k chan = do
 
 -- Send friend requests and remote presences stored in remotesByPeer to XMPP
 -- clients.
-sendCachedPresence :: PresenceState -> ConnectionKey -> IO ()
+sendCachedPresence :: PresenceState -> ClientAddress -> IO ()
 sendCachedPresence state k = do
     forClient state k (return ()) $ \client -> do
     rbp <- atomically $ readTVar (remotesByPeer state)
     jids <- configText ConfigFiles.getBuddies (clientUser client) (clientProfile client)
     let hosts = map ((\(_,h,_)->h) . splitJID) jids
     addrs <- resolveAllPeers hosts
-    let onlines = rbp `Map.intersection` Map.mapKeys PeerKey addrs
-        ClientKey laddr = k
-    mcon <- atomically $ do ktc <- readTVar (keyToChan state)
+    let onlines = rbp `Map.intersection` addrs
+    mcon <- atomically $ do ktc <- readTVar (ckeyToChan state)
                             return $ Map.lookup k ktc
     forM_ mcon $ \con -> do
     forM_ (Map.toList onlines) $ \(pk, umap) -> do
@@ -855,7 +868,7 @@ sendCachedPresence state k = do
         let h = peerKeyToText pk
         forM_ (Map.toList $ resources rp) $ \(resource,stanza) -> do
         let jid = unsplitJID (Just user,h,Just resource)
-        (mine,js) <- multiplyJIDForClient laddr jid
+        (mine,js) <- multiplyJIDForClient k jid
         forM_ js $ \jid -> do
         let from' = unsplitJID jid
         dup <- cloneStanza stanza
@@ -883,7 +896,7 @@ addToRosterFile ::
                   -> t1)
                  -> Text -- user
                  -> Text -- profile
-                 -> Text -> [SockAddr] -> t1
+                 -> Text -> [PeerAddress] -> t1
 addToRosterFile doit whose profile to addrs =
     modifyRosterFile doit whose profile to addrs True
 
@@ -895,7 +908,7 @@ removeFromRosterFile ::
                        -> t1)
                       -> Text -- user
                       -> Text -- profile
-                      -> Text -> [SockAddr] -> t1
+                      -> Text -> [PeerAddress] -> t1
 removeFromRosterFile doit whose profile to addrs =
     modifyRosterFile doit whose profile to addrs False
 
@@ -920,7 +933,7 @@ modifyRosterFile ::
                   -> Text       -- ^ user
                   -> Text       -- ^ profile
                   -> Text       -- ^ JID that will be added or removed a hostname
-                  -> [SockAddr] -- ^ Alias addresses for hostname in the JID.
+                  -> [PeerAddress] -- ^ Alias addresses for hostname in the JID.
                   -> Bool       -- ^ True if adding, otherwise False
                   -> t1
 modifyRosterFile doit whose profile to addrs bAdd = do
@@ -951,7 +964,7 @@ modifyRosterFile doit whose profile to addrs bAdd = do
          (guard bAdd >> Just (textToLazyByteString to))
 
 
-clientSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
+clientSubscriptionRequest :: PresenceState -> IO () -> ClientAddress -> Stanza -> TChan Stanza -> IO ()
 clientSubscriptionRequest state fail k stanza chan = do
     forClient state k fail $ \client -> do
     fromMaybe fail $ (splitJID <$> stanzaTo stanza) <&> \(mu,h,_) -> do
@@ -967,7 +980,7 @@ clientSubscriptionRequest state fail k stanza chan = do
     addToRosterFile      ConfigFiles.modifySolicited cuser cprof to addrs
     removeFromRosterFile ConfigFiles.modifyBuddies   cuser cprof to addrs
     resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers cuser cprof
-    let is_subscribed = not . null $ [ (mu, PeerKey a) | a <- addrs ]
+    let is_subscribed = not . null $ [ (mu, a) | a <- addrs ]
                                      `intersect` resolved_subs
     -- subscribers: "from"
     -- buddies: "to"
@@ -975,16 +988,18 @@ clientSubscriptionRequest state fail k stanza chan = do
     case state of
       PresenceState { server = svVar } -> do
 
-        (ktc,(sv,conns)) <- atomically $
-            liftM2 (,) (readTVar $ keyToChan state)
-                       (takeTMVar svVar)
+        (cktc,pktc,(sv,conns)) <- atomically $ do
+            cktc <- readTVar $ ckeyToChan state
+            pktc <- readTVar $ pkeyToChan state
+            sc <- takeTMVar svVar
+            return (cktc,pktc,sc)
 
         -- Update roster for each client.
         case stanzaType stanza of
          PresenceRequestSubscription True -> do
             hostname <- nameForClient state k
             let cjid = unsplitJID (Just $ clientUser client, hostname,Nothing)
-            chans <- clientCons state ktc (clientUser client)
+            chans <- clientCons state cktc (clientUser client)
             forM_ chans $ \( Conn { connChan=chan }, client ) -> do
                 -- roster update ask="subscribe"
                 update <- makeRosterUpdate cjid to
@@ -996,13 +1011,13 @@ clientSubscriptionRequest state fail k stanza chan = do
          _ -> return ()
 
         -- Send friend request to peer.
-        let dsts = ktc `Map.intersection`
-                        Map.fromList [ (PeerKey a, ()) | a <- addrs ]
+        let dsts = pktc `Map.intersection` toMapUnit addrs
         forM_ (Map.toList dsts) $ \(pk,con) -> do
             -- if already connected, send solicitation ...
             -- let from = clientJID con client
-            let from = unsplitJID ( Just $ clientUser client
-                                  , addrToText $ cdAddr $ auxData con
+            let Left laddr = cdAddr $ auxData con
+                from = unsplitJID ( Just $ clientUser client
+                                  , (\(Local a) -> addrToText a) $ laddr
                                   , Nothing )
             mb <- rewriteJIDForPeer to
             forM_ mb $ \(to',addr) -> do
@@ -1022,20 +1037,20 @@ clientSubscriptionRequest state fail k stanza chan = do
 
 resolvedFromRoster
   :: (ConfigFiles.User -> ConfigFiles.Profile -> IO [L.ByteString])
-     -> UserName -> Text -> IO [(Maybe UserName, ConnectionKey)]
+     -> UserName -> Text -> IO [(Maybe UserName, PeerAddress)]
 resolvedFromRoster doit u profile = do
     subs <- configText doit u profile
     runTraversableT $ do
             (mu,h,_) <- liftT $ splitJID `fmap` subs
             addr <- liftMT $ fmap nub $ resolvePeer h
-            return (mu,PeerKey addr)
+            return (mu,addr)
 
 clientCons :: PresenceState
-            -> Map ConnectionKey t -> Text -> IO [(t, ClientState)]
+            -> Map ClientAddress t -> Text -> IO [(t, ClientState)]
 clientCons state ktc u = map snd <$> clientCons' state ktc u
 
 clientCons' :: PresenceState
-            -> Map ConnectionKey t -> Text -> IO [(ConnectionKey,(t, ClientState))]
+            -> Map ClientAddress t -> Text -> IO [(ClientAddress,(t, ClientState))]
 clientCons' state ktc u = do
     mlp <- atomically $ do
             cmap <- readTVar $ clientsByUser state
@@ -1047,7 +1062,14 @@ clientCons' state ktc u = do
             return (k,(con,client))
     return $ mapMaybe doit ks
 
-peerSubscriptionRequest :: PresenceState -> IO () -> ConnectionKey -> Stanza -> TChan Stanza -> IO ()
+releventProfiles :: ConnectionType -> Text -> IO [Text]
+releventProfiles XMPP _    = return ["."]
+releventProfiles ctyp user = do
+    -- TODO: Return all the ".tox" profiles that a user has under his
+    -- .presence/ directory.
+    return []
+
+peerSubscriptionRequest :: PresenceState -> IO () -> PeerAddress -> Stanza -> TChan Stanza -> IO ()
 peerSubscriptionRequest state fail k stanza chan = do
     putStrLn $ "Handling pending subscription from remote"
     fromMaybe fail $ (stanzaFrom stanza) <&> \from -> do
@@ -1056,24 +1078,20 @@ peerSubscriptionRequest state fail k stanza chan = do
         (mfrom_u,from_h,_) = splitJID from
     to <- return $ unsplitJID (mto_u,h,Nothing) -- delete resource
     from <- return $ unsplitJID (mfrom_u,from_h,Nothing) -- delete resource
-    (ktc,cmap) <- atomically $ (,) <$> readTVar (keyToChan state)
-                                   <*> readTVar (clients state)
-    fromMaybe fail $ (Map.lookup k ktc)
-        <&> \Conn { auxData=ConnectionData laddr ctyp } -> do
+    (pktc,cktc,cmap) <- atomically $ do
+        cktc <- readTVar (ckeyToChan state)
+        pktc <- readTVar (pkeyToChan state)
+        cmap <- readTVar (clients state)
+        return (pktc,cktc,cmap)
+    fromMaybe fail $ (Map.lookup k pktc)
+        <&> \Conn { auxData=ConnectionData (Left laddr) ctyp } -> do
     (mine,totup) <- rewriteJIDForClient laddr to []
     if not mine then fail else do
     (_,fromtup) <- rewriteJIDForClient laddr from []
     fromMaybe fail $ mto_u <&> \u -> do
     fromMaybe fail $ mfrom_u <&> \from_u -> do
-    let profile = fromMaybe "." $ clientProfile <$> Map.lookup k cmap
-    -- XXX profile is wrong.
-    -- TODO Likely the problem is that k is a peer ConnectionKey and of course
-    --      will have no entry in the cmap.  Thus giving "." even though it ought
-    --      to be using a tox profile.
-    --
-    -- Solution 1: Only .tox peers go in a tox profile.
-    -- Solution 2: Duplicate non .tox peers in all profiles.
-    -- Solution 3: Only one profile is active at a time.
+    profiles <- releventProfiles ctyp u
+    forM_ profiles $ \profile -> do
     resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u profile
     let already_subscribed = elem (mfrom_u,k) resolved_subs
         is_wanted = case stanzaType stanza of
@@ -1116,7 +1134,7 @@ peerSubscriptionRequest state fail k stanza chan = do
     when (not already_pending) $ do
     -- contact ∉ subscribers & contact ∉ pending --> MUST
 
-    chans <- clientCons state ktc u
+    chans <- clientCons state cktc u
     forM_ chans $ \( Conn { connChan=chan }, client ) -> do
     -- send to clients
     -- TODO: interested/available clients only?
@@ -1128,7 +1146,7 @@ peerSubscriptionRequest state fail k stanza chan = do
 
 clientInformSubscription :: PresenceState
                           -> IO ()
-                          -> ConnectionKey
+                          -> ClientAddress
                           -> StanzaWrap (LockedChan Event)
                           -> IO ()
 clientInformSubscription state fail k stanza = do
@@ -1139,7 +1157,7 @@ clientInformSubscription state fail k stanza = do
     addrs <- resolvePeer h
     -- remove from pending
     buds <- resolvedFromRoster ConfigFiles.getBuddies (clientUser client) (clientProfile client)
-    let is_buddy = not . null $ map ((mu,) . PeerKey) addrs `intersect` buds
+    let is_buddy = not . null $ map (mu,) addrs `intersect` buds
     removeFromRosterFile ConfigFiles.modifyPending (clientUser client) (clientProfile client) to addrs
     let (relationship,addf,remf) =
          case stanzaType stanza of
@@ -1160,12 +1178,13 @@ clientInformSubscription state fail k stanza = do
         putStrLn $ "cbu = " ++ show (fmap (fmap clientPid . networkClients) cbu)
 
     -- send roster update to clients
-    (clients,ktc) <- atomically $ do
+    (clients,ktc,pktc) <- atomically $ do
         cbu <- readTVar (clientsByUser state)
         let mlp = Map.lookup (clientUser client) cbu
         let cs = maybe [] (Map.toList . networkClients) mlp
-        ktc <- readTVar (keyToChan state)
-        return (cs,ktc)
+        ktc <- readTVar (ckeyToChan state)
+        pktc <- readTVar (pkeyToChan state)
+        return (cs,ktc,pktc)
     forM_ clients $ \(ck, client) -> do
         is_intereseted <- atomically $ clientIsInterested client
         putStrLn $ "clientIsInterested: "++show is_intereseted
@@ -1179,8 +1198,8 @@ clientInformSubscription state fail k stanza = do
         sendModifiedStanzaToClient update (connChan con)
 
     -- notify peer
-    let dsts = Map.fromList $ map ((,()) . PeerKey) addrs
-        cdsts = ktc `Map.intersection` dsts
+    let dsts = toMapUnit addrs
+        cdsts = pktc `Map.intersection` dsts
     forM_ (Map.toList cdsts) $ \(pk,con) -> do
         let from = clientJID con client
             to' = unsplitJID (mu, peerKeyToText pk, Nothing)
@@ -1192,18 +1211,21 @@ clientInformSubscription state fail k stanza = do
 
 peerInformSubscription :: PresenceState
                         -> IO ()
-                        -> ConnectionKey
+                        -> PeerAddress
                         -> StanzaWrap (LockedChan Event)
                         -> IO ()
 peerInformSubscription state fail k stanza = do
     putStrLn $ "TODO: peerInformSubscription"
     -- remove from solicited
     fromMaybe fail $ (stanzaFrom stanza) <&> \from -> do
-    (ktc,cmap) <- atomically $ (,) <$> readTVar (keyToChan state)
-                                   <*> readTVar (clients state)
+    (ktc,cktc,cmap) <- atomically $ do
+        pktc <- readTVar (pkeyToChan state)
+        cktc <- readTVar (ckeyToChan state)
+        cmap <- readTVar (clients state)
+        return (pktc,cktc,cmap)
     fromMaybe fail $ (Map.lookup k ktc)
         <&> \(Conn { connChan=sender_chan
-                   , auxData =ConnectionData laddr ctyp }) -> do
+                   , auxData =ConnectionData (Left laddr) ctyp }) -> do
     (_,(from_u,from_h,_)) <- rewriteJIDForClient laddr from []
     let from'' = unsplitJID (from_u,from_h,Nothing)
         muser = do
@@ -1215,10 +1237,11 @@ peerInformSubscription state fail k stanza = do
     -- This would allow us to answer anonymous probes with 'unsubscribed'.
     fromMaybe fail $ muser <&> \user -> do
     addrs <- resolvePeer from_h
-    let profile = fromMaybe "." $ clientProfile <$> Map.lookup k cmap
+    profiles <- releventProfiles ctyp user
+    forM_ profiles $ \profile -> do
     was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user profile from'' addrs
     subs <- resolvedFromRoster ConfigFiles.getSubscribers user profile
-    let is_sub = not . null $ map ((from_u,) . PeerKey) addrs `intersect` subs
+    let is_sub = not . null $ map (from_u,) addrs `intersect` subs
     putStrLn $ "DEBUG peerInformSubscription (is_sub,typ)=" ++ show (is_sub,stanzaType stanza)
     let (relationship,addf,remf) =
          case stanzaType stanza of
@@ -1234,7 +1257,7 @@ peerInformSubscription state fail k stanza = do
     addToRosterFile      addf user profile from'' addrs
     removeFromRosterFile remf user profile from'' addrs
 
-    chans <- clientCons' state ktc user
+    chans <- clientCons' state cktc user
     forM_ chans $ \(ckey,(Conn { connChan=chan }, client)) -> do
     hostname <- nameForClient state ckey
     let to' = unsplitJID (Just user, hostname, Nothing)