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
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
|
{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
module ToxManager where
import Announcer
import Announcer.Tox
import Connection
-- import Control.Concurrent
import Control.Concurrent.STM
import Control.Monad
import Crypto.Tox
import qualified Data.HashMap.Strict as HashMap
import qualified Data.Map as Map
import Data.Maybe
import qualified Data.Text as T
import Network.Kademlia.Routing as R
import Network.Kademlia.Search
import qualified Network.Tox as Tox
import Network.Tox.ContactInfo as Tox
import qualified Network.Tox.Crypto.Handlers as Tox
-- import qualified Network.Tox.DHT.Handlers as Tox
import qualified Network.Tox.DHT.Transport as Tox
import qualified Network.Tox.Onion.Handlers as Tox
import qualified Network.Tox.Onion.Transport as Tox
import Presence
import Text.Read
import ToxToXMPP
import XMPPServer (ClientAddress)
import DPut
toxAnnounceSendData :: Tox.Tox JabberClients
-> PublicKey
-> Nonce32
-> Maybe Tox.NodeInfo
-> IO (Maybe (Tox.Rendezvous, Tox.AnnounceResponse))
toxAnnounceSendData tox pubkey token = \case
Just ni -> Tox.putRendezvous (Tox.onionTimeout tox)
(Tox.toxCryptoKeys tox)
(Tox.toxOnion tox)
(pubkey :: PublicKey)
(token :: Nonce32)
ni
Nothing -> return Nothing
akeyAccountActive :: Announcer -> Tox.NodeId{- our public tox key -} -> AnnounceKey
akeyAccountActive announcer pubid = packAnnounceKey announcer $ "toxid:" ++ show pubid
-- |
--
-- These hooks will be invoked in order to connect to *.tox hosts in a user's
-- XMPP roster.
toxman :: Announcer
-> [(String,TVar (BucketList Tox.NodeInfo))]
-> Tox.Tox JabberClients
-> PresenceState
-> ToxManager ClientAddress
toxman announcer toxbkts tox presence = ToxManager
{ activateAccount = \k pubname seckey -> do
dput XMan $ "toxman ACTIVATE " ++ show (Tox.key2id $ toPublic seckey)
let ContactInfo{ accounts } = Tox.toxContactInfo tox
pub = toPublic seckey
pubid = Tox.key2id pub
(acnt,newlyActive) <- atomically $ do
macnt <- HashMap.lookup pubid <$> readTVar accounts
acnt <- maybe (newAccount seckey Map.empty) return macnt
rs <- readTVar $ accountExtra acnt
perclient <- initPerClient
writeTVar (accountExtra acnt) $! Map.insert k perclient rs
modifyTVar accounts (HashMap.insert pubid acnt)
if not (Map.null rs)
then return (acnt,Nothing)
else return (acnt,Just $ \nid -> foldr interweave []
. map (R.kclosest (searchSpace (toxQSearch tox))
searchK
nid)
<$> mapM (readTVar . snd) toxbkts)
forM_ newlyActive $ \nearNodes -> do
-- Schedule recurring announce.
--
let akey = akeyAccountActive announcer pubid
scheduleAnnounce announcer
akey
(AnnounceMethod (toxQSearch tox)
(toxAnnounceSendData tox)
nearNodes
pubid
toxAnnounceInterval)
pub
forkAccountWatcher acnt tox presence announcer
return ()
, deactivateAccount = \k pubname -> do
dput XMan $ "toxman DECTIVATE (todo) 1 " ++ show pubname
let ContactInfo{ accounts } = Tox.toxContactInfo tox
mpubid = readMaybe $ T.unpack $ T.take 43 pubname
bStopped <- fmap (fromMaybe Nothing) $ atomically $ do
forM mpubid $ \pubid -> do
refs <- do
macnt <- HashMap.lookup pubid <$> readTVar accounts
rs <- fromMaybe Map.empty <$> mapM (readTVar . accountExtra) macnt
forM_ macnt $ \acnt -> do
-- Remove this xmpp client /k/ from the set holding this
-- account active.
modifyTVar' (accountExtra acnt) $ Map.delete k
return rs
if (Map.null $ Map.delete k refs) then do
let akey = akeyAccountActive announcer pubid
fmap Just $ forM toxbkts $ \(nm,bkts) -> do
return (akey,bkts)
else return Nothing
forM_ bStopped $ \kbkts -> do
let Just pubid = mpubid
pub = Tox.id2key pubid
-- Stop the announce-toxid task for this account. Note that other
-- announced tasks will be stopped by the forkAccountWatcher thread
-- when it terminates.
forM_ kbkts $ \(akey,bkts) -> do
cancel announcer akey
, setToxConnectionPolicy = \me them p -> do
let m = do meid <- readMaybe $ T.unpack $ T.take 43 me
themid <- readMaybe $ T.unpack $ T.take 43 them
return $ Tox.Key meid themid
dput XMan $ "toxman ConnectionPolicy " ++ show (me,them,p,fmap (const ()) m)
forM_ m $ \k -> do
setPolicy (Tox.toxMgr tox) k p
case p of
TryingToConnect -> do
let db@ContactInfo{ accounts } = Tox.toxContactInfo tox
sequence_ $ do
let Tox.Key meid themid = k
Just $ atomically $ do
accs <- readTVar accounts
case HashMap.lookup meid accs of
Nothing -> return () -- Unknown account.
Just acc -> setContactPolicy (Tox.id2key themid) TryingToConnect acc
-- If unscheduled and unconnected, schedule recurring search for this contact.
_ -> return () -- Remove contact.
}
|
