summaryrefslogtreecommitdiff
path: root/Roster.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Roster.hs')
-rw-r--r--Roster.hs55
1 files changed, 55 insertions, 0 deletions
diff --git a/Roster.hs b/Roster.hs
new file mode 100644
index 00000000..94ab462d
--- /dev/null
+++ b/Roster.hs
@@ -0,0 +1,55 @@
1{-# LANGUAGE NamedFieldPuns #-}
2module Roster where
3
4import Crypto.PubKey.Curve25519
5import Network.Tox.Onion.Transport as Onion
6import Network.Tox.DHT.Transport as DHT
7import Network.Tox.NodeId
8import Control.Concurrent.STM
9import qualified Data.HashMap.Strict as HashMap
10import Data.HashMap.Strict (HashMap)
11
12newtype Roster = Roster { accounts :: TVar (HashMap NodeId Account) }
13
14data Account = Account
15 { userSecret :: SecretKey -- local secret key
16 , contacts :: TVar (HashMap NodeId DHT.DHTPublicKey) -- received contact info
17 }
18
19newRoster :: IO Roster
20newRoster = atomically $ Roster <$> newTVar HashMap.empty
21
22newAccount :: SecretKey -> STM Account
23newAccount sk = Account sk <$> newTVar HashMap.empty
24
25addRoster :: Roster -> SecretKey -> STM ()
26addRoster (Roster as) sk = do
27 a <- newAccount sk
28 modifyTVar' as $ HashMap.insert (key2id $ toPublic sk) a
29
30delRoster :: Roster -> PublicKey -> STM ()
31delRoster (Roster as) pk = modifyTVar' as $ HashMap.delete (key2id pk)
32
33updateRoster :: Roster -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO ()
34updateRoster roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do
35 atomically $ do
36 as <- readTVar (accounts roster)
37 maybe (return ())
38 (updateAccount remoteUserKey omsg)
39 $ HashMap.lookup (key2id localUserKey) as
40
41
42updateConcts :: DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey -> Maybe DHT.DHTPublicKey
43updateConcts new (Just old) | DHT.dhtpkNonce old < DHT.dhtpkNonce new = Just new
44updateConcts new Nothing = Just new
45updateConcts _ old = old
46
47
48updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
49updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do
50 modifyTVar' (contacts acc) $ HashMap.alter (updateConcts dhtpk)
51 (key2id remoteUserKey)
52
53updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do
54 -- TODO
55 return ()