diff options
Diffstat (limited to 'src/Network/Tox')
-rw-r--r-- | src/Network/Tox/ContactInfo.hs | 19 |
1 files changed, 13 insertions, 6 deletions
diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs index 3f794197..1970b782 100644 --- a/src/Network/Tox/ContactInfo.hs +++ b/src/Network/Tox/ContactInfo.hs | |||
@@ -1,4 +1,5 @@ | |||
1 | {-# LANGUAGE NamedFieldPuns #-} | 1 | {-# LANGUAGE NamedFieldPuns #-} |
2 | {-# LANGUAGE LambdaCase #-} | ||
2 | module Network.Tox.ContactInfo where | 3 | module Network.Tox.ContactInfo where |
3 | 4 | ||
4 | import Connection | 5 | import Connection |
@@ -30,13 +31,13 @@ data Account extra = Account | |||
30 | 31 | ||
31 | data ContactEvent = OnionRouted { contact :: PublicKey, onionRouted :: OnionData } | 32 | data ContactEvent = OnionRouted { contact :: PublicKey, onionRouted :: OnionData } |
32 | | PolicyChange { contact :: PublicKey, policyChange :: Policy } | 33 | | PolicyChange { contact :: PublicKey, policyChange :: Policy } |
33 | | AddrChange { contact :: PublicKey, addrChange :: SockAddr } | 34 | | AddrChange { contact :: PublicKey, addrChange :: NodeInfo } |
34 | | SessionEstablished { contact :: PublicKey } | 35 | | SessionEstablished { contact :: PublicKey } |
35 | | SessionTerminated { contact :: PublicKey } | 36 | | SessionTerminated { contact :: PublicKey } |
36 | 37 | ||
37 | data Contact = Contact | 38 | data Contact = Contact |
38 | { contactKeyPacket :: TVar (Maybe (POSIXTime,DHT.DHTPublicKey)) | 39 | { contactKeyPacket :: TVar (Maybe (POSIXTime,DHT.DHTPublicKey)) |
39 | , contactLastSeenAddr :: TVar (Maybe (POSIXTime,SockAddr)) | 40 | , contactLastSeenAddr :: TVar (Maybe (POSIXTime,NodeInfo)) |
40 | , contactFriendRequest :: TVar (Maybe (POSIXTime,DHT.FriendRequest)) | 41 | , contactFriendRequest :: TVar (Maybe (POSIXTime,DHT.FriendRequest)) |
41 | , contactPolicy :: TVar (Maybe Connection.Policy) | 42 | , contactPolicy :: TVar (Maybe Connection.Policy) |
42 | } | 43 | } |
@@ -97,7 +98,7 @@ onionUpdate now (Onion.OnionFriendRequest fr) contact | |||
97 | policyUpdate :: Policy -> Contact -> STM () | 98 | policyUpdate :: Policy -> Contact -> STM () |
98 | policyUpdate policy contact = writeTVar (contactPolicy contact) $ Just policy | 99 | policyUpdate policy contact = writeTVar (contactPolicy contact) $ Just policy |
99 | 100 | ||
100 | addrUpdate :: POSIXTime -> SockAddr -> Contact -> STM () | 101 | addrUpdate :: POSIXTime -> NodeInfo -> Contact -> STM () |
101 | addrUpdate now addr contact = writeTVar (contactLastSeenAddr contact) $ Just (now,addr) | 102 | addrUpdate now addr contact = writeTVar (contactLastSeenAddr contact) $ Just (now,addr) |
102 | 103 | ||
103 | setContactPolicy :: PublicKey -> Policy -> Account extra -> STM () | 104 | setContactPolicy :: PublicKey -> Policy -> Account extra -> STM () |
@@ -105,10 +106,16 @@ setContactPolicy remoteUserKey policy acc = do | |||
105 | updateAccount' remoteUserKey acc $ policyUpdate policy | 106 | updateAccount' remoteUserKey acc $ policyUpdate policy |
106 | writeTChan (eventChan acc) $ PolicyChange remoteUserKey policy | 107 | writeTChan (eventChan acc) $ PolicyChange remoteUserKey policy |
107 | 108 | ||
108 | setContactAddr :: POSIXTime -> PublicKey -> SockAddr -> Account extra -> STM () | 109 | setContactAddr :: POSIXTime -> PublicKey -> NodeInfo -> Account extra -> STM () |
109 | setContactAddr now remoteUserKey addr acc = do | 110 | setContactAddr now remoteUserKey addr acc = do |
110 | updateAccount' remoteUserKey acc $ addrUpdate now addr | 111 | contact <- getContact remoteUserKey acc |
111 | writeTChan (eventChan acc) $ AddrChange remoteUserKey addr | 112 | let update = updateAccount' remoteUserKey acc $ addrUpdate now addr |
113 | let notify = writeTChan (eventChan acc) $ AddrChange remoteUserKey addr | ||
114 | join <$> traverse (readTVar . contactLastSeenAddr) contact >>= \case | ||
115 | Just (_, a) | addr == a -> update -- updates time only | ||
116 | Just (t, _) | now > t + 60 -> update >> notify -- update IP if existing one is old | ||
117 | Nothing -> update >> notify -- or if we don't have any | ||
118 | _ -> return () -- otherwise just wait | ||
112 | 119 | ||
113 | setEstablished :: POSIXTime -> PublicKey -> Account extra -> STM () | 120 | setEstablished :: POSIXTime -> PublicKey -> Account extra -> STM () |
114 | setEstablished now remoteUserKey acc = | 121 | setEstablished now remoteUserKey acc = |