WIP: Deliver friend-request to xmpp client.

1 files changed, 69 insertions, 0 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index b018e47b..fca8ee30 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -1,11 +1,80 @@
+{-# LANGUAGE CPP #-}
+{-# LANGUAGE LambdaCase #-}
 module ToxToXMPP where
 
 import Data.Conduit                 as C
 import Data.XML.Types               as XML
 import Network.Tox.Crypto.Transport as Tox
 
+import Announcer
+import Connection
+import Connection.Tox                as Connection
+import Control.Concurrent.STM
+import Control.Concurrent.STM.TChan
+import Control.Monad
+import Crypto.Tox
+import Data.Bits
+import Data.Function
+import qualified Data.HashMap.Strict as HashMap
+import qualified Data.Set            as Set
+import qualified Data.Text           as T
+         ;import Data.Text           (Text)
+import Data.Word
+import Network.Tox
+import Network.Tox.ContactInfo
+import Network.Tox.DHT.Transport     (FriendRequest (..))
+import Network.Tox.NodeId
+import Network.Tox.Onion.Transport   (OnionData (..))
+import Presence
+import XMPPServer
+#ifdef THREAD_DEBUG
+import Control.Concurrent.Lifted.Instrument
+#else
+import Control.Concurrent.Lifted
+import GHC.Conc                  (labelThread)
+#endif
+
 xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage
 xmppToTox = _todo
 
 toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event
 toxToXmpp = _todo
+
+accountJID :: Account -> Text
+accountJID acnt = _todo -- Or perhaps this should be passed in from PresenceState
+
+key2jid :: Word32 -> PublicKey -> Text
+key2jid nospam key = T.pack $ show $ NoSpamId nsp key
+ where
+    nsp = NoSpam nospam (Just sum)
+    sum = nlo `xor` nhi `xor` xorsum key
+    nlo = fromIntegral (0x0FFFF .&. nospam) :: Word16
+    nhi = fromIntegral (0x0FFFF .&. (nospam `shiftR` 16)) :: Word16
+
+dispatch acnt conn (PolicyChange theirkey policy                  ) = return () -- todo
+dispatch acnt conn (OnionRouted  theirkey (OnionDHTPublicKey pkey)) = return () -- todo
+dispatch acnt conn (OnionRouted  theirkey (OnionFriendRequest fr) ) = do
+    let self = accountJID acnt
+        theirjid = key2jid (friendNoSpam fr) theirkey
+    ask <- presenceSolicitation theirjid self
+    sendModifiedStanzaToClient ask (connChan conn)
+
+forkAccountWatcher :: Account -> Tox -> Conn -> IO ThreadId
+forkAccountWatcher acc tox conn = forkIO $ do
+    myThreadId >>= flip labelThread "tox-account"
+    (chan,contacts) <- atomically $ do
+                chan <- dupTChan $ eventChan acc -- duplicate broadcast channel for reading.
+                contacts <- readTVar (contacts acc)
+                return (chan,contacts)
+    -- TODO: process information in contacts HashMap.
+
+    -- Loop endlessly until clientRefs is null.
+    fix $ \loop -> do
+    mev <- atomically $
+            (Just <$> readTChan chan)
+            `orElse` do
+                refs <- readTVar $ clientRefs acc
+                check $ Set.null refs
+                return Nothing
+    forM_ mev $ \ev -> dispatch acc conn ev >> loop
+