summaryrefslogtreecommitdiff
path: root/ToxToXMPP.hs
diff options
context:
space:
mode:
Diffstat (limited to 'ToxToXMPP.hs')
-rw-r--r--ToxToXMPP.hs69
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 @@
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE LambdaCase #-}
1module ToxToXMPP where 3module ToxToXMPP where
2 4
3import Data.Conduit as C 5import Data.Conduit as C
4import Data.XML.Types as XML 6import Data.XML.Types as XML
5import Network.Tox.Crypto.Transport as Tox 7import Network.Tox.Crypto.Transport as Tox
6 8
9import Announcer
10import Connection
11import Connection.Tox as Connection
12import Control.Concurrent.STM
13import Control.Concurrent.STM.TChan
14import Control.Monad
15import Crypto.Tox
16import Data.Bits
17import Data.Function
18import qualified Data.HashMap.Strict as HashMap
19import qualified Data.Set as Set
20import qualified Data.Text as T
21 ;import Data.Text (Text)
22import Data.Word
23import Network.Tox
24import Network.Tox.ContactInfo
25import Network.Tox.DHT.Transport (FriendRequest (..))
26import Network.Tox.NodeId
27import Network.Tox.Onion.Transport (OnionData (..))
28import Presence
29import XMPPServer
30#ifdef THREAD_DEBUG
31import Control.Concurrent.Lifted.Instrument
32#else
33import Control.Concurrent.Lifted
34import GHC.Conc (labelThread)
35#endif
36
7xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage 37xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage
8xmppToTox = _todo 38xmppToTox = _todo
9 39
10toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event 40toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event
11toxToXmpp = _todo 41toxToXmpp = _todo
42
43accountJID :: Account -> Text
44accountJID acnt = _todo -- Or perhaps this should be passed in from PresenceState
45
46key2jid :: Word32 -> PublicKey -> Text
47key2jid nospam key = T.pack $ show $ NoSpamId nsp key
48 where
49 nsp = NoSpam nospam (Just sum)
50 sum = nlo `xor` nhi `xor` xorsum key
51 nlo = fromIntegral (0x0FFFF .&. nospam) :: Word16
52 nhi = fromIntegral (0x0FFFF .&. (nospam `shiftR` 16)) :: Word16
53
54dispatch acnt conn (PolicyChange theirkey policy ) = return () -- todo
55dispatch acnt conn (OnionRouted theirkey (OnionDHTPublicKey pkey)) = return () -- todo
56dispatch acnt conn (OnionRouted theirkey (OnionFriendRequest fr) ) = do
57 let self = accountJID acnt
58 theirjid = key2jid (friendNoSpam fr) theirkey
59 ask <- presenceSolicitation theirjid self
60 sendModifiedStanzaToClient ask (connChan conn)
61
62forkAccountWatcher :: Account -> Tox -> Conn -> IO ThreadId
63forkAccountWatcher acc tox conn = forkIO $ do
64 myThreadId >>= flip labelThread "tox-account"
65 (chan,contacts) <- atomically $ do
66 chan <- dupTChan $ eventChan acc -- duplicate broadcast channel for reading.
67 contacts <- readTVar (contacts acc)
68 return (chan,contacts)
69 -- TODO: process information in contacts HashMap.
70
71 -- Loop endlessly until clientRefs is null.
72 fix $ \loop -> do
73 mev <- atomically $
74 (Just <$> readTChan chan)
75 `orElse` do
76 refs <- readTVar $ clientRefs acc
77 check $ Set.null refs
78 return Nothing
79 forM_ mev $ \ev -> dispatch acc conn ev >> loop
80