From 07b1494c9d5c692371c9689a8f78f4cf7ee58732 Mon Sep 17 00:00:00 2001 From: joe Date: Mon, 18 Jun 2018 00:49:38 -0400 Subject: Tox: Added timestamps to dhtkey and sockaddr information. --- src/Network/Tox/ContactInfo.hs | 46 ++++++++++++++++++++--------------------- src/Network/Tox/DHT/Handlers.hs | 10 +++++---- 2 files changed, 28 insertions(+), 28 deletions(-) (limited to 'src/Network/Tox') diff --git a/src/Network/Tox/ContactInfo.hs b/src/Network/Tox/ContactInfo.hs index 7f74caff..47c07237 100644 --- a/src/Network/Tox/ContactInfo.hs +++ b/src/Network/Tox/ContactInfo.hs @@ -4,6 +4,7 @@ module Network.Tox.ContactInfo where import ConnectionKey import Connection +import Data.Time.Clock.POSIX import Control.Concurrent.STM import Control.Monad import Crypto.PubKey.Curve25519 @@ -35,14 +36,10 @@ data ContactEvent = OnionRouted { contact :: PublicKey, onionRouted :: OnionDat | AddrChange { contact :: PublicKey, addrChange :: SockAddr } data Contact = Contact - { contactKeyPacket :: TVar (Maybe (DHT.DHTPublicKey)) - , contactLastSeenAddr :: TVar (Maybe SockAddr) - , contactFriendRequest :: TVar (Maybe (DHT.FriendRequest)) - , contactPolicy :: TVar (Maybe (Connection.Policy)) - -- Possible semantics - -- RefusingToConnect : rejected friend-request or blocked or unknown. - -- OpenToConnect : pending friend-request. - -- TryingToConnect : roster entry. + { contactKeyPacket :: TVar (Maybe (POSIXTime,DHT.DHTPublicKey)) + , contactLastSeenAddr :: TVar (Maybe (POSIXTime,SockAddr)) + , contactFriendRequest :: TVar (Maybe (POSIXTime,DHT.FriendRequest)) + , contactPolicy :: TVar (Maybe Connection.Policy) } newContactInfo :: IO ContactInfo @@ -57,10 +54,11 @@ myKeyPairs (ContactInfo accounts) = do updateContactInfo :: ContactInfo -> Onion.AnnouncedRendezvous -> (PublicKey,Onion.OnionData) -> IO () updateContactInfo roster Onion.AnnouncedRendezvous{remoteUserKey} (localUserKey,omsg) = do hPutStrLn stderr "updateContactInfo!!!" + now <- getPOSIXTime atomically $ do as <- readTVar (accounts roster) maybe (return ()) - (updateAccount remoteUserKey omsg) + (updateAccount now remoteUserKey omsg) $ HashMap.lookup (key2id localUserKey) as initContact :: STM Contact @@ -80,31 +78,31 @@ updateAccount' remoteUserKey acc updater = do return contact updater contact -updateAccount :: PublicKey -> Onion.OnionData -> Account -> STM () -updateAccount remoteUserKey omsg acc = do - updateAccount' remoteUserKey acc $ onionUpdate omsg +updateAccount :: POSIXTime -> PublicKey -> Onion.OnionData -> Account -> STM () +updateAccount now remoteUserKey omsg acc = do + updateAccount' remoteUserKey acc $ onionUpdate now omsg writeTChan (eventChan acc) $ OnionRouted remoteUserKey omsg -onionUpdate :: OnionData -> Contact -> STM () -onionUpdate (Onion.OnionDHTPublicKey dhtpk) contact - = writeTVar (contactKeyPacket contact) $ Just dhtpk -onionUpdate (Onion.OnionFriendRequest fr) contact - = writeTVar (contactFriendRequest contact) $ Just fr +onionUpdate :: POSIXTime -> OnionData -> Contact -> STM () +onionUpdate now (Onion.OnionDHTPublicKey dhtpk) contact + = writeTVar (contactKeyPacket contact) $ Just (now,dhtpk) +onionUpdate now (Onion.OnionFriendRequest fr) contact + = writeTVar (contactFriendRequest contact) $ Just (now,fr) policyUpdate :: Policy -> Contact -> STM () policyUpdate policy contact = writeTVar (contactPolicy contact) $ Just policy -addrUpdate :: SockAddr -> Contact -> STM () -addrUpdate addr contact = writeTVar (contactLastSeenAddr contact) $ Just addr +addrUpdate :: POSIXTime -> SockAddr -> Contact -> STM () +addrUpdate now addr contact = writeTVar (contactLastSeenAddr contact) $ Just (now,addr) setContactPolicy :: PublicKey -> Policy -> Account -> STM () setContactPolicy remoteUserKey policy acc = do updateAccount' remoteUserKey acc $ policyUpdate policy writeTChan (eventChan acc) $ PolicyChange remoteUserKey policy -setContactAddr :: PublicKey -> SockAddr -> Account -> STM () -setContactAddr remoteUserKey addr acc = do - updateAccount' remoteUserKey acc $ addrUpdate addr +setContactAddr :: POSIXTime -> PublicKey -> SockAddr -> Account -> STM () +setContactAddr now remoteUserKey addr acc = do + updateAccount' remoteUserKey acc $ addrUpdate now addr writeTChan (eventChan acc) $ AddrChange remoteUserKey addr @@ -129,7 +127,7 @@ dnsPresentation (ContactInfo accsvar) = do cs <- readTVar cvar rs <- forM (HashMap.toList cs) $ \(nid,c) -> do mkpkt <- readTVar (contactKeyPacket c) - return $ fmap ((,) nid) mkpkt + return $ fmap (\(_,d) -> (nid,d)) mkpkt return $ "; local key = " ++ show (key2id $ toPublic sec) ++ "\n" ++ concatMap dnsPresentation1 (catMaybes rs) @@ -150,6 +148,6 @@ friendRequests (ContactInfo roster) = do cs <- readTVar cvar rs <- forM (HashMap.toList cs) $ \(nid,c) -> do mfr <- readTVar (contactFriendRequest c) - return $ fmap ((,) nid) mfr + return $ fmap (\(_,x) -> (nid,x)) mfr return $ catMaybes rs diff --git a/src/Network/Tox/DHT/Handlers.hs b/src/Network/Tox/DHT/Handlers.hs index 6a80b4a4..7e986fdd 100644 --- a/src/Network/Tox/DHT/Handlers.hs +++ b/src/Network/Tox/DHT/Handlers.hs @@ -117,8 +117,8 @@ classify client msg = fromMaybe (IsUnknown "unknown") data NodeInfoCallback = NodeInfoCallback { interestingNodeId :: NodeId , listenerId :: Int - , observedAddress :: NodeInfo -> STM () - , rumoredAddress :: SockAddr -> NodeInfo -> STM () + , observedAddress :: POSIXTime -> NodeInfo -> STM () + , rumoredAddress :: POSIXTime -> SockAddr -> NodeInfo -> STM () } data Routing = Routing @@ -405,22 +405,24 @@ getNodes client cbvar nid addr = do -- hPutStrLn stderr $ show addr ++ " -sendnodes-> " ++ show reply forM_ (join reply) $ \(SendNodes ns) -> forM_ ns $ \n -> do + now <- getPOSIXTime atomically $ do mcbs <- HashMap.lookup (nodeId n) <$> readTVar cbvar forM_ mcbs $ \cbs -> do forM_ cbs $ \cb -> do - rumoredAddress cb (nodeAddr addr) n + rumoredAddress cb now (nodeAddr addr) n return $ fmap unwrapNodes $ join reply updateRouting :: Client -> Routing -> OnionRouter -> NodeInfo -> Message -> IO () updateRouting client routing orouter naddr msg | PacketKind 0x21 <- msgType msg = dput XLan "(tox)updateRouting: ignoring lan discovery" -- ignore lan discovery | otherwise = do + now <- getPOSIXTime atomically $ do m <- HashMap.lookup (nodeId naddr) <$> readTVar (nodesOfInterest routing) forM_ m $ mapM_ $ \NodeInfoCallback{interestingNodeId,observedAddress} -> do when (interestingNodeId == nodeId naddr) - $ observedAddress naddr + $ observedAddress now naddr case prefer4or6 naddr Nothing of Want_IP4 -> updateTable client naddr orouter (committee4 routing) (refresher4 routing) Want_IP6 -> updateTable client naddr orouter (committee6 routing) (refresher6 routing) -- cgit v1.2.3