blob: fca8ee30eb08834eb3a588c928892b99b3eb3330 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
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
|
