blob: ab2f99112f40764f8088896bd9cfccc71806cd30 (
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
|
{-# LANGUAGE NamedFieldPuns #-}
module Roster where
import System.IO
import Control.Monad
import Control.Concurrent.STM
import Crypto.PubKey.Curve25519
import qualified Data.HashMap.Strict as HashMap
;import Data.HashMap.Strict (HashMap)
import Network.Tox.DHT.Transport as DHT
import Network.Tox.NodeId
import Network.Tox.Onion.Transport as Onion
newtype Roster = Roster { accounts :: TVar (HashMap NodeId Account) }
data Account = Account
{ userSecret :: SecretKey -- local secret key
, contacts :: TVar (HashMap NodeId DHT.DHTPublicKey) -- received contact info
}
newRoster :: IO Roster
newRoster = atomically $ Roster <$> newTVar HashMap.empty
newAccount :: SecretKey -> STM Account
newAccount sk = Account sk <$> newTVar HashMap.empty
addRoster :: Roster -> SecretKey -> STM ()
addRoster (Roster as) sk = do
a <- newAccount sk
modifyTVar' as $ HashMap.insert (key2id $ toPublic sk) a
delRoster :: Roster -> PublicKey -> STM ()
delRoster (Roster as) pk = modifyTVar' as $ HashMap.delete (key2id pk)
updateRoster :: Roster -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO ()
updateRoster roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do
hPutStrLn stderr "updateRoster!!!"
atomically $ do
as <- readTVar (accounts roster)
maybe (return ())
(updateAccount remoteUserKey omsg)
$ HashMap.lookup (key2id localUserKey) as
updateConcts :: DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey
updateConcts new (Just old) | DHT.dhtpkNonce old < DHT.dhtpkNonce new = Just new
updateConcts new Nothing = Just new
updateConcts _ old = old
updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
modifyTVar' (contacts acc) $ HashMap.alter (updateConcts dhtpk)
(key2id remoteUserKey)
updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
-- TODO
return ()
dnsPresentation :: Roster -> STM String
dnsPresentation (Roster accsvar) = do
accs <- readTVar accsvar
ms <- forM accs $ \Account { userSecret = sec, contacts = cvar } -> do
cs <- readTVar cvar
return $
"; local key = " ++ show (key2id $ toPublic sec) ++ "\n"
++ concatMap dnsPresentation1 (HashMap.toList cs)
return $ concat ms
dnsPresentation1 :: (NodeId,DHTPublicKey) -> String
dnsPresentation1 (nid,dk) = unlines
[ concat [ show nid, ".tox. IN CNAME ", show (key2id $ dhtpk dk), ".dht." ]
]
|
