summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/Tox/ContactInfo.hs35
1 files changed, 25 insertions, 10 deletions
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs
index 153cd130..880740bf 100644
--- a/src/Network/Tox/ContactInfo.hs
+++ b/src/Network/Tox/ContactInfo.hs
@@ -27,15 +27,19 @@ data Account = Account
27 { userSecret :: SecretKey -- local secret key 27 { userSecret :: SecretKey -- local secret key
28 , contacts :: TVar (HashMap NodeId{-friend's userkey-} Contact) -- received contact info 28 , contacts :: TVar (HashMap NodeId{-friend's userkey-} Contact) -- received contact info
29 , clientRefs :: TVar (Set ConnectionKey) -- reference count so we know when to send offline etc 29 , clientRefs :: TVar (Set ConnectionKey) -- reference count so we know when to send offline etc
30 , eventChan :: TChan ContactEvent
30 } 31 }
31 32
33data ContactEvent = OnionRouted { contact :: PublicKey, onionRouted :: OnionData }
34 | PolicyChange { contact :: PublicKey, policyChange :: Policy }
35
32data Contact = Contact 36data Contact = Contact
33 { contactKeyPacket :: Maybe (DHT.DHTPublicKey) 37 { contactKeyPacket :: Maybe (DHT.DHTPublicKey)
34 , contactLastSeenAddr :: Maybe SockAddr 38 , contactLastSeenAddr :: Maybe SockAddr
35 , contactFriendRequest :: Maybe (DHT.FriendRequest) 39 , contactFriendRequest :: Maybe (DHT.FriendRequest)
36 , contactPolicy :: Maybe (Connection.Policy) 40 , contactPolicy :: Maybe (Connection.Policy)
37 -- Possible semantics 41 -- Possible semantics
38 -- RefusingToConnect : rejected friend-request or blocked. 42 -- RefusingToConnect : rejected friend-request or blocked or unknown.
39 -- OpenToConnect : pending friend-request. 43 -- OpenToConnect : pending friend-request.
40 -- TryingToConnect : roster entry. 44 -- TryingToConnect : roster entry.
41 } 45 }
@@ -43,6 +47,7 @@ data Contact = Contact
43nullContact :: Contact 47nullContact :: Contact
44nullContact = Contact 48nullContact = Contact
45 { contactKeyPacket = Nothing 49 { contactKeyPacket = Nothing
50 , contactLastSeenAddr = Nothing
46 , contactFriendRequest = Nothing 51 , contactFriendRequest = Nothing
47 , contactPolicy = Nothing 52 , contactPolicy = Nothing
48 } 53 }
@@ -69,6 +74,7 @@ newContactInfo = atomically $ ContactInfo <$> newTVar HashMap.empty
69newAccount :: SecretKey -> STM Account 74newAccount :: SecretKey -> STM Account
70newAccount sk = Account sk <$> newTVar HashMap.empty 75newAccount sk = Account sk <$> newTVar HashMap.empty
71 <*> newTVar Set.empty 76 <*> newTVar Set.empty
77 <*> newBroadcastTChan
72 78
73addContactInfo :: ContactInfo -> SecretKey -> STM () 79addContactInfo :: ContactInfo -> SecretKey -> STM ()
74addContactInfo (ContactInfo as) sk = do 80addContactInfo (ContactInfo as) sk = do
@@ -88,16 +94,25 @@ updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,
88 $ HashMap.lookup (key2id localUserKey) as 94 $ HashMap.lookup (key2id localUserKey) as
89 95
90 96
97onionUpdate :: OnionData -> Maybe Contact -> Maybe Contact
98onionUpdate (Onion.OnionDHTPublicKey dhtpk)
99 = mergeContact nullContact { contactKeyPacket = Just dhtpk }
100onionUpdate (Onion.OnionFriendRequest fr)
101 = mergeContact nullContact { contactFriendRequest = Just fr }
102
103policyUpdate :: Policy -> Maybe Contact -> Maybe Contact
104policyUpdate policy = mergeContact nullContact { contactPolicy = Just policy }
105
91updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM () 106updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM ()
92updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do 107updateAccount remoteUserKey omsg acc = do
93 modifyTVar' (contacts acc) 108 modifyTVar' (contacts acc) $ HashMap.alter (onionUpdate omsg) (key2id remoteUserKey)
94 $ HashMap.alter (mergeContact nullContact { contactKeyPacket = Just dhtpk }) 109 writeTChan (eventChan acc) $ OnionRouted remoteUserKey omsg
95 (key2id remoteUserKey) 110
96 111setContactPolicy :: PublicKey -> Policy -> Account -> STM ()
97updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do 112setContactPolicy remoteUserKey policy acc = do
98 modifyTVar' (contacts acc) 113 modifyTVar' (contacts acc) $ HashMap.alter (policyUpdate policy) (key2id remoteUserKey)
99 $ HashMap.alter (mergeContact nullContact { contactFriendRequest = Just fr }) 114 writeTChan (eventChan acc) $ PolicyChange remoteUserKey policy
100 (key2id remoteUserKey) 115
101 116
102dnsPresentation :: ContactInfo -> STM String 117dnsPresentation :: ContactInfo -> STM String
103dnsPresentation (ContactInfo accsvar) = do 118dnsPresentation (ContactInfo accsvar) = do