xmpp: allow server to change it's name (important for tox peers).

1 files changed, 18 insertions, 16 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 5fe4e8cf..e8a69066 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -437,7 +437,7 @@ sendProbesAndSolicitations state k (Local laddr) chan = do
                                  unsplitJID (Just user,me,Nothing)
         stanza <- make from jid
         -- send probes for buddies, solicitations for solicited.
-        putStrLn $ "probing "++show k++" for: " ++ show (isbud,jid)
+        dput XJabber $ "probing "++show k++" for: " ++ show (isbud,jid)
         atomically $ writeTChan chan stanza
     -- reverse xs `seq` return ()
 
@@ -622,7 +622,7 @@ deliverMessage state fail msg =
                 XMPP -> return $ stanzaTo msg
                 Tox  -> return $ Just $ unsplitJID (Just user, profile, Nothing)
             return (from',chan)
-        putStrLn $ "chan count: " ++ show (length chans)
+        dput XJabber $ "chan count: " ++ show (length chans)
         if null chans then when (ctyp == XMPP) $ do
             forM_ (stanzaFrom msg) $ \from -> do
             from' <- do
@@ -722,10 +722,10 @@ informPeerPresence :: PresenceState
                     -> IO ()
 informPeerPresence state k stanza = do
     -- Presence must indicate full JID with resource...
-    putStrLn $ "xmppInformPeerPresence checking from address..."
+    dput XJabber $ "xmppInformPeerPresence checking from address..."
     forM_ (stanzaFrom stanza) $ \from -> do
     let (muser,h,mresource) = splitJID from
-    putStrLn $ "xmppInformPeerPresence from  = " ++ show from
+    dput XJabber $ "xmppInformPeerPresence from  = " ++ show from
     -- forM_ mresource       $ \resource -> do
     forM_ muser           $ \user -> do
 
@@ -765,18 +765,18 @@ informPeerPresence state k stanza = do
         (ck,client) <- liftMT $ fmap Map.toList $ readTVar (clients state)
         con <- liftMaybe $ Map.lookup ck ktc
         return (ck,con,client)
-    putStrLn $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
+    dput XJabber $ "xmppInformPeerPresence (length clients="++show (length clients)++")"
     forM_ clients $ \(ck,con,client) -> do
         -- (TODO: appropriately authorized clients only.)
         -- For now, all "available" clients (available = sent initial presence)
         is_avail <- atomically $ clientIsAvailable client
         when is_avail $ do
-        putStrLn $ "reversing for client: " ++ show from
+        dput XJabber $ "reversing for client: " ++ show from
         froms <- do -- flip (maybe $ return [from]) k . const $ do
             (_,trip) <- multiplyJIDForClient ck from
             return (map unsplitJID trip)
 
-        putStrLn $ "sending to client: " ++ show (stanzaType stanza,froms)
+        dput XJabber $ "sending to client: " ++ show (stanzaType stanza,froms)
         forM_ froms $ \from' -> do
         dup <- cloneStanza stanza
         sendModifiedStanzaToClient (dup { stanzaFrom=Just from' })
@@ -789,7 +789,7 @@ consoleClients _                                        = return Map.empty
 
 answerProbe :: PresenceState -> Maybe Text -> PeerAddress -> TChan Stanza -> IO ()
 answerProbe state mto k chan = do
-    -- putStrLn $ "answerProbe! " ++ show (stanzaType stanza)
+    -- dput XJabber $ "answerProbe! " ++ show (stanzaType stanza)
     ktc <- atomically $ readTVar (pkeyToChan state)
     muser <- runTraversableT $ do
         to <- liftT $ mto
@@ -966,7 +966,7 @@ clientSubscriptionRequest :: PresenceState -> IO () -> ClientAddress -> Stanza -
 clientSubscriptionRequest state fail k stanza chan = do
     forClient state k fail $ \client -> do
     fromMaybe fail $ (splitJID <$> stanzaTo stanza) <&> \(mu,h,_) -> do
-    putStrLn $ "Forwarding solictation to peer"
+    dput XJabber $ "Forwarding solictation to peer"
     let to    = unsplitJID (mu,h,Nothing) -- deleted resource
         cuser = clientUser client
         cprof = clientProfile client
@@ -1069,7 +1069,7 @@ releventProfiles ctyp user = do
 
 peerSubscriptionRequest :: PresenceState -> IO () -> PeerAddress -> Stanza -> TChan Stanza -> IO ()
 peerSubscriptionRequest state fail k stanza chan = do
-    putStrLn $ "Handling pending subscription from remote"
+    dput XJabber $ "Handling pending subscription from remote"
     fromMaybe fail $ (stanzaFrom stanza) <&> \from -> do
     fromMaybe fail $ (stanzaTo stanza) <&> \to -> do
     let (mto_u,h,_) = splitJID to
@@ -1148,7 +1148,7 @@ clientInformSubscription :: PresenceState
 clientInformSubscription state fail k stanza = do
     forClient state k fail $ \client -> do
     fromMaybe fail $ (stanzaTo stanza) <&> \to -> do
-    putStrLn $ "clientInformSubscription"
+    dput XJabber $ "clientInformSubscription"
     let (mu,h,mr) = splitJID to
     addrs <- resolvePeer h
     -- remove from pending
@@ -1171,7 +1171,7 @@ clientInformSubscription state fail k stanza = do
 
     do
         cbu <- atomically $ readTVar (clientsByUser state)
-        putStrLn $ "cbu = " ++ show (fmap (fmap clientPid . networkClients) cbu)
+        dput XJabber $ "cbu = " ++ show (fmap (fmap clientPid . networkClients) cbu)
 
     -- send roster update to clients
     (clients,ktc,pktc) <- atomically $ do
@@ -1183,7 +1183,7 @@ clientInformSubscription state fail k stanza = do
         return (cs,ktc,pktc)
     forM_ clients $ \(ck, client) -> do
         is_intereseted <- atomically $ clientIsInterested client
-        putStrLn $ "clientIsInterested: "++show is_intereseted
+        dput XJabber $ "clientIsInterested: "++show is_intereseted
         is_intereseted <- atomically $ clientIsInterested client
         when is_intereseted $ do
         forM_ (Map.lookup ck ktc) $ \con -> do
@@ -1211,7 +1211,7 @@ peerInformSubscription :: PresenceState
                         -> StanzaWrap (LockedChan Event)
                         -> IO ()
 peerInformSubscription state fail k stanza = do
-    putStrLn $ "TODO: peerInformSubscription"
+    dput XJabber $ "TODO: peerInformSubscription"
     -- remove from solicited
     fromMaybe fail $ (stanzaFrom stanza) <&> \from -> do
     (ktc,cktc,cmap) <- atomically $ do
@@ -1219,7 +1219,7 @@ peerInformSubscription state fail k stanza = do
         cktc <- readTVar (ckeyToChan state)
         cmap <- readTVar (clients state)
         return (pktc,cktc,cmap)
-    fromMaybe fail $ (Map.lookup k ktc)
+    fromMaybe fail $ Map.lookup k ktc
         <&> \(Conn { connChan=sender_chan
                    , auxData =ConnectionData (Left laddr) ctyp profile}) -> do
     (_,(from_u,from_h,_)) <- rewriteJIDForClient laddr from []
@@ -1232,11 +1232,13 @@ peerInformSubscription state fail k stanza = do
     -- should probably mean unsubscribed for all users.
     -- This would allow us to answer anonymous probes with 'unsubscribed'.
     fromMaybe fail $ muser <&> \user -> do
+
     addrs <- resolvePeer from_h
     was_solicited <- removeFromRosterFile ConfigFiles.modifySolicited user profile from'' addrs
+
     subs <- resolvedFromRoster ConfigFiles.getSubscribers user profile
     let is_sub = not . null $ map (from_u,) addrs `intersect` subs
-    putStrLn $ "DEBUG peerInformSubscription (is_sub,typ)=" ++ show (is_sub,stanzaType stanza)
+    dput XJabber $ "DEBUG peerInformSubscription (is_sub,typ)=" ++ show (is_sub,stanzaType stanza)
     let (relationship,addf,remf) =
          case stanzaType stanza of
            PresenceInformSubscription True ->