Finished TODO stubs: Multiple identities/rosters for a single unix user.

1 files changed, 20 insertions, 14 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 9b91dc1d..4cb6266a 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -667,7 +667,8 @@ answerProbe :: PresenceState
              -> Maybe Text -> ConnectionKey -> TChan Stanza -> IO ()
 answerProbe state mto k chan = do
     -- putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
-    ktc <- atomically $ readTVar (keyToChan state)
+    (ktc,cmap) <- atomically $ (,) <$> readTVar (keyToChan state)
+                                   <*> readTVar (clients state)
     muser <- runTraversableT $ do
         to <- liftT $ mto
         conn <- liftT $ Map.lookup k ktc
@@ -675,12 +676,13 @@ answerProbe state mto k chan = do
                                    --  probes.  Is this correct? Check the spec.
         liftMT $ guardPortStrippedAddress h (auxAddr conn)
         u <- liftT mu
-        let ch = addrToText (auxAddr conn)
-        return (u,conn,ch)
+        let ch      = addrToText (auxAddr conn)
+            profile = fromMaybe "." $ clientProfile <$> Map.lookup k cmap
+        return (u,profile,conn,ch)
 
-    flip (maybe $ return ()) muser $ \(u,conn,ch) -> do
+    flip (maybe $ return ()) muser $ \(u,profile,conn,ch) -> do
 
-    resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u (_todo {- profile -})
+    resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u profile
     let gaddrs = groupBy (\a b -> snd a == snd b) (sort resolved_subs)
         whitelist = do
             xs <- gaddrs
@@ -905,7 +907,8 @@ 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 <- atomically . readTVar $ keyToChan state
+    (ktc,cmap) <- atomically $ (,) <$> readTVar (keyToChan state)
+                                   <*> readTVar (clients state)
     flip (maybe fail) (Map.lookup k ktc)
          $ \Conn { auxAddr=laddr } -> do
     (mine,totup) <- rewriteJIDForClient laddr to []
@@ -913,7 +916,8 @@ peerSubscriptionRequest state fail k stanza chan = do
     (_,fromtup) <- rewriteJIDForClient laddr from []
     flip (maybe fail) mto_u $ \u -> do
     flip (maybe fail) mfrom_u $ \from_u -> do
-    resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u (_todo {- profile -})
+    let profile = fromMaybe "." $ clientProfile <$> Map.lookup k cmap
+    resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers u profile
     let already_subscribed = elem (mfrom_u,k) resolved_subs
         is_wanted = case stanzaType stanza of
                       PresenceRequestSubscription b -> b
@@ -943,9 +947,9 @@ peerSubscriptionRequest state fail k stanza chan = do
 
     already_pending <-
       if is_wanted then
-        addToRosterFile ConfigFiles.modifyPending u (_todo {- profile -}) from' addrs
+        addToRosterFile ConfigFiles.modifyPending u profile from' addrs
       else do
-        removeFromRosterFile ConfigFiles.modifySubscribers u (_todo {- profile -}) from' addrs
+        removeFromRosterFile ConfigFiles.modifySubscribers u profile from' addrs
         reply <- makeInformSubscription "jabber:server" to from is_wanted
         sendModifiedStanzaToPeer reply chan
         return False
@@ -1037,7 +1041,8 @@ peerInformSubscription state fail k stanza = do
     putStrLn $ "TODO: peerInformSubscription"
     -- remove from solicited
     flip (maybe fail) (stanzaFrom stanza) $ \from -> do
-    ktc <- atomically $ readTVar (keyToChan state)
+    (ktc,cmap) <- atomically $ (,) <$> readTVar (keyToChan state)
+                                   <*> readTVar (clients state)
     flip (maybe fail) (Map.lookup k ktc)
         $ \(Conn { connChan=sender_chan
                  , auxAddr=laddr }) -> do
@@ -1052,8 +1057,9 @@ peerInformSubscription state fail k stanza = do
     -- This would allow us to answer anonymous probes with 'unsubscribed'.
     flip (maybe fail) muser $ \user -> do
     addrs <- resolvePeer from_h
-    was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user (_todo {- profile -}) from'' addrs
-    subs <- resolvedFromRoster ConfigFiles.getSubscribers user (_todo {- profile -})
+    let profile = fromMaybe "." $ clientProfile <$> Map.lookup k cmap
+    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 (relationship,addf,remf) =
          case stanzaType stanza of
@@ -1066,8 +1072,8 @@ peerInformSubscription state fail k stanza = do
                                              else "none")
                 , ConfigFiles.modifyOthers
                 , ConfigFiles.modifyBuddies )
-    addToRosterFile      addf user (_todo {- profile -}) from'' addrs
-    removeFromRosterFile remf user (_todo {- profile -}) from'' addrs
+    addToRosterFile      addf user profile from'' addrs
+    removeFromRosterFile remf user profile from'' addrs
 
     hostname <- textHostName
     let to' = unsplitJID (Just user, hostname, Nothing)