summaryrefslogtreecommitdiff
path: root/src/Network/Tox
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/Tox')
-rw-r--r--src/Network/Tox/ContactInfo.hs19
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 #-}
2module Network.Tox.ContactInfo where 3module Network.Tox.ContactInfo where
3 4
4import Connection 5import Connection
@@ -30,13 +31,13 @@ data Account extra = Account
30 31
31data ContactEvent = OnionRouted { contact :: PublicKey, onionRouted :: OnionData } 32data 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
37data Contact = Contact 38data 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
97policyUpdate :: Policy -> Contact -> STM () 98policyUpdate :: Policy -> Contact -> STM ()
98policyUpdate policy contact = writeTVar (contactPolicy contact) $ Just policy 99policyUpdate policy contact = writeTVar (contactPolicy contact) $ Just policy
99 100
100addrUpdate :: POSIXTime -> SockAddr -> Contact -> STM () 101addrUpdate :: POSIXTime -> NodeInfo -> Contact -> STM ()
101addrUpdate now addr contact = writeTVar (contactLastSeenAddr contact) $ Just (now,addr) 102addrUpdate now addr contact = writeTVar (contactLastSeenAddr contact) $ Just (now,addr)
102 103
103setContactPolicy :: PublicKey -> Policy -> Account extra -> STM () 104setContactPolicy :: 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
108setContactAddr :: POSIXTime -> PublicKey -> SockAddr -> Account extra -> STM () 109setContactAddr :: POSIXTime -> PublicKey -> NodeInfo -> Account extra -> STM ()
109setContactAddr now remoteUserKey addr acc = do 110setContactAddr 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
113setEstablished :: POSIXTime -> PublicKey -> Account extra -> STM () 120setEstablished :: POSIXTime -> PublicKey -> Account extra -> STM ()
114setEstablished now remoteUserKey acc = 121setEstablished now remoteUserKey acc =