diff options
Diffstat (limited to 'src/Network/Tox/ContactInfo.hs')
-rw-r--r-- | src/Network/Tox/ContactInfo.hs | 35 |
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 | ||
33 | data ContactEvent = OnionRouted { contact :: PublicKey, onionRouted :: OnionData } | ||
34 | | PolicyChange { contact :: PublicKey, policyChange :: Policy } | ||
35 | |||
32 | data Contact = Contact | 36 | data 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 | |||
43 | nullContact :: Contact | 47 | nullContact :: Contact |
44 | nullContact = Contact | 48 | nullContact = 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 | |||
69 | newAccount :: SecretKey -> STM Account | 74 | newAccount :: SecretKey -> STM Account |
70 | newAccount sk = Account sk <$> newTVar HashMap.empty | 75 | newAccount sk = Account sk <$> newTVar HashMap.empty |
71 | <*> newTVar Set.empty | 76 | <*> newTVar Set.empty |
77 | <*> newBroadcastTChan | ||
72 | 78 | ||
73 | addContactInfo :: ContactInfo -> SecretKey -> STM () | 79 | addContactInfo :: ContactInfo -> SecretKey -> STM () |
74 | addContactInfo (ContactInfo as) sk = do | 80 | addContactInfo (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 | ||
97 | onionUpdate :: OnionData -> Maybe Contact -> Maybe Contact | ||
98 | onionUpdate (Onion.OnionDHTPublicKey dhtpk) | ||
99 | = mergeContact nullContact { contactKeyPacket = Just dhtpk } | ||
100 | onionUpdate (Onion.OnionFriendRequest fr) | ||
101 | = mergeContact nullContact { contactFriendRequest = Just fr } | ||
102 | |||
103 | policyUpdate :: Policy -> Maybe Contact -> Maybe Contact | ||
104 | policyUpdate policy = mergeContact nullContact { contactPolicy = Just policy } | ||
105 | |||
91 | updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM () | 106 | updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM () |
92 | updateAccount remoteUserKey (Onion.OnionDHTPublicKey dhtpk) acc = do | 107 | updateAccount 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 | 111 | setContactPolicy :: PublicKey -> Policy -> Account -> STM () | |
97 | updateAccount remoteUserKey (Onion.OnionFriendRequest fr) acc = do | 112 | setContactPolicy 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 | ||
102 | dnsPresentation :: ContactInfo -> STM String | 117 | dnsPresentation :: ContactInfo -> STM String |
103 | dnsPresentation (ContactInfo accsvar) = do | 118 | dnsPresentation (ContactInfo accsvar) = do |