Enable xmpp client to use long-form hex toxid for add-buddy operation.

1 files changed, 41 insertions, 15 deletions

diff --git a/Presence/Presence.hs b/Presence/Presence.hs
index 53de4e93..45569d32 100644
--- a/Presence/Presence.hs
+++ b/Presence/Presence.hs
@@ -49,7 +49,7 @@ import ConsoleWriter
 import ClientState
 import Util
 import qualified Connection
-import Network.Tox.NodeId (key2id)
+import Network.Tox.NodeId (key2id,parseNoSpamId,nospam64,NoSpamId(..))
 import Crypto.Tox (decodeSecret)
 import DPut
 
@@ -334,25 +334,31 @@ rosterGetStuff
      -> PresenceState -> ClientAddress -> IO [Text]
 rosterGetStuff what state k = forClient state k (return [])
     $ \client -> do
-    jids <- configText what (clientUser client) (clientProfile client)
-    let hosts = map ((\(_,h,_)->h) . splitJID) jids
+    jids0 <- configText what (clientUser client) (clientProfile client)
+    let jids = map splitJID jids0
     -- Using case to bring 'status' type variable to Connection.Manager into scope.
     case state of
       PresenceState { server = svVar } -> do
         (sv,conns) <- atomically $ takeTMVar svVar
         -- Grok peers to associate with from the roster:
-        forM_ hosts $ \host -> do
+        let isTox = do (me  , ".tox") <- Just $ Text.splitAt 43 (clientProfile client)
+                       return me
+            noToxUsers (u,h,r)
+                | Text.isSuffixOf ".tox" h = unsplitJID (Nothing,h,r)
+                | otherwise                = unsplitJID (u,h,r)
+        forM_ jids $ \(_,host,_) -> do
             -- We need either conns  :: Connection.Manager TCPStatus Text
             --             or toxman :: ToxManager ClientAddress
             -- It is decided by checking hostnames for .tox ending.
             let policySetter = fromMaybe (Connection.setPolicy conns host) $ do
+                    isTox
                     toxman <- toxManager state
-                    (me  , ".tox") <- Just $ Text.splitAt 43 (clientProfile client)
                     (them, ".tox") <- Just $ Text.splitAt 43 host
                     Just $ setToxConnectionPolicy toxman (clientProfile client) host
             policySetter Connection.TryingToConnect
         atomically $ putTMVar svVar (sv,conns)
-        return jids
+        return $ fromMaybe jids0 $ do isTox
+                                      Just $ map noToxUsers jids
 
 rosterGetBuddies :: PresenceState -> ClientAddress -> IO [Text]
 rosterGetBuddies state k = rosterGetStuff ConfigFiles.getBuddies state k
@@ -397,7 +403,7 @@ getSolicited' = configText ConfigFiles.getSolicited
 --
 --   * Text - Unix user who owns this roster entry.
 --
---   * Text - Profile, "." for xmpp, "tox" for a tox-enabled client.
+--   * Text - Profile, "." for xmpp, "<base64-key>.tox" for a tox-enabled client.
 --
 getBuddiesAndSolicited :: PresenceState
                          -> Text              -- ^ Config profile: "." or tox host.
@@ -993,14 +999,24 @@ clientSubscriptionRequest state fail k stanza chan = do
     forClient state k fail $ \client -> do
     fromMaybe fail $ (splitJID <$> stanzaTo stanza) <&> \(mu,h,_) -> do
     dput XJabber $ "Forwarding solictation to peer"
-    let to    = unsplitJID (mu,h,Nothing) -- deleted resource
+    let to0   = unsplitJID (mu,h,Nothing) -- deleted resource
         cuser = clientUser client
         cprof = clientProfile client
-    fromMaybe fail $ mu <&> \u -> do
+        mto = if ".tox" `Text.isSuffixOf` cprof
+          then case parseNoSpamId to0 of
+            Right toxjid@(NoSpamId nspam _)   -> Just ( Text.pack $ '$' : nospam64 nspam
+                                                      , Text.pack $ show toxjid
+                                                      , return [] )
+            Left _ | Text.isSuffixOf ".tox" h -> Nothing
+            Left _ | Text.all isHexDigit h
+                     && Text.length h == 76   -> Nothing
+            Left _ -> fmap (\u -> (u, to0 ,resolvePeer h)) mu
+          else fmap (\u -> (u, to0 ,resolvePeer h)) mu
+    fromMaybe fail $ mto <&> \(u,to,resolv) -> do
     -- add to-address to from's solicited
-    addrs <- if all (".tox" `Text.isSuffixOf`) [cprof,h]
-                then return [] -- Avoid resolving .tox peers.
-                else resolvePeer h
+    dput XJabber $ unlines [ "to0=" ++ Text.unpack to0
+                           , "to=" ++ show (Text.unpack to) ]
+    addrs <- resolv
     addToRosterFile      ConfigFiles.modifySolicited cuser cprof to addrs
     removeFromRosterFile ConfigFiles.modifyBuddies   cuser cprof to addrs
     resolved_subs <- resolvedFromRoster ConfigFiles.getSubscribers cuser cprof
@@ -1026,12 +1042,16 @@ clientSubscriptionRequest state fail k stanza chan = do
             chans <- clientCons state cktc (clientUser client)
             forM_ chans $ \( Conn { connChan=chan }, client ) -> do
                 -- roster update ask="subscribe"
-                update <- makeRosterUpdate cjid to
+                update <- myMakeRosterUpdate (clientProfile client) cjid to
                     [ ("ask","subscribe")
                     , if is_subscribed then ("subscription","from")
                                        else ("subscription","none")
                     ]
                 sendModifiedStanzaToClient update chan
+                when (to /= to0) $ do
+                    removal <- myMakeRosterUpdate (clientProfile client) cjid to0
+                        [ ("subscription","remove") ]
+                    sendModifiedStanzaToClient removal chan
          _ -> return ()
 
         -- Send friend request to peer.
@@ -1169,6 +1189,12 @@ peerSubscriptionRequest state fail k stanza chan = do
                                    , stanzaTo = Just $ unsplitJID totup }
                                chan
 
+myMakeRosterUpdate prf tojid contact as
+    | ".tox" `Text.isSuffixOf` prf
+    , (Just u,h,r) <- splitJID contact
+    , ".tox" `Text.isSuffixOf` u      = XMPPServer.makeRosterUpdate tojid (unsplitJID (Nothing,h,r)) as
+myMakeRosterUpdate _ tojid contact as = XMPPServer.makeRosterUpdate tojid contact as
+
 
 clientInformSubscription :: PresenceState
                           -> IO ()
@@ -1220,7 +1246,7 @@ clientInformSubscription state fail k stanza = do
         hostname <- nameForClient state ck
         -- TODO: Should cjid include the resource?
         let cjid = unsplitJID (mu, hostname, Nothing)
-        update <- makeRosterUpdate cjid to [relationship]
+        update <- myMakeRosterUpdate (clientProfile client) cjid to [relationship]
         sendModifiedStanzaToClient update (connChan con)
 
     -- notify peer
@@ -1287,7 +1313,7 @@ peerInformSubscription state fail k stanza = do
     forM_ chans $ \(ckey,(Conn { connChan=chan }, client)) -> do
     hostname <- nameForClient state ckey
     let to' = unsplitJID (Just user, hostname, Nothing)
-    update <- makeRosterUpdate to' from'' [relationship]
+    update <- myMakeRosterUpdate (clientProfile client) to' from'' [relationship]
     is_intereseted <- atomically $ clientIsInterested client
     when is_intereseted $ do
         sendModifiedStanzaToClient update chan