diff options
Diffstat (limited to 'ToxToXMPP.hs')
-rw-r--r-- | ToxToXMPP.hs | 69 |
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 #-} | ||
1 | module ToxToXMPP where | 3 | module ToxToXMPP where |
2 | 4 | ||
3 | import Data.Conduit as C | 5 | import Data.Conduit as C |
4 | import Data.XML.Types as XML | 6 | import Data.XML.Types as XML |
5 | import Network.Tox.Crypto.Transport as Tox | 7 | import Network.Tox.Crypto.Transport as Tox |
6 | 8 | ||
9 | import Announcer | ||
10 | import Connection | ||
11 | import Connection.Tox as Connection | ||
12 | import Control.Concurrent.STM | ||
13 | import Control.Concurrent.STM.TChan | ||
14 | import Control.Monad | ||
15 | import Crypto.Tox | ||
16 | import Data.Bits | ||
17 | import Data.Function | ||
18 | import qualified Data.HashMap.Strict as HashMap | ||
19 | import qualified Data.Set as Set | ||
20 | import qualified Data.Text as T | ||
21 | ;import Data.Text (Text) | ||
22 | import Data.Word | ||
23 | import Network.Tox | ||
24 | import Network.Tox.ContactInfo | ||
25 | import Network.Tox.DHT.Transport (FriendRequest (..)) | ||
26 | import Network.Tox.NodeId | ||
27 | import Network.Tox.Onion.Transport (OnionData (..)) | ||
28 | import Presence | ||
29 | import XMPPServer | ||
30 | #ifdef THREAD_DEBUG | ||
31 | import Control.Concurrent.Lifted.Instrument | ||
32 | #else | ||
33 | import Control.Concurrent.Lifted | ||
34 | import GHC.Conc (labelThread) | ||
35 | #endif | ||
36 | |||
7 | xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage | 37 | xmppToTox :: Conduit XML.Event IO Tox.CryptoMessage |
8 | xmppToTox = _todo | 38 | xmppToTox = _todo |
9 | 39 | ||
10 | toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event | 40 | toxToXmpp :: Conduit Tox.CryptoMessage IO XML.Event |
11 | toxToXmpp = _todo | 41 | toxToXmpp = _todo |
42 | |||
43 | accountJID :: Account -> Text | ||
44 | accountJID acnt = _todo -- Or perhaps this should be passed in from PresenceState | ||
45 | |||
46 | key2jid :: Word32 -> PublicKey -> Text | ||
47 | key2jid 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 | |||
54 | dispatch acnt conn (PolicyChange theirkey policy ) = return () -- todo | ||
55 | dispatch acnt conn (OnionRouted theirkey (OnionDHTPublicKey pkey)) = return () -- todo | ||
56 | dispatch 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 | |||
62 | forkAccountWatcher :: Account -> Tox -> Conn -> IO ThreadId | ||
63 | forkAccountWatcher 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 | |||