blob: 94ab462dc94b63e4700b09d97c764792da5be18a (
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
|
{-# LANGUAGE NamedFieldPuns #-}
module Roster where
import Crypto.PubKey.Curve25519
import Network.Tox.Onion.Transport as Onion
import Network.Tox.DHT.Transport as DHT
import Network.Tox.NodeId
import Control.Concurrent.STM
import qualified Data.HashMap.Strict as HashMap
import Data.HashMap.Strict (HashMap)
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
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 ()
|
