{-# 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 :: Account -> Conn -> ContactEvent -> IO () 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