Tox: Added timestamps to dhtkey and sockaddr information.

2 files changed, 28 insertions, 28 deletions

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)