active nc sessions should be looked up by sockaddr, not key

1 files changed, 12 insertions, 14 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index b004083f..8d28507a 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE ViewPatterns #-}
 {-# LANGUAGE CPP                      #-}
 {-# LANGUAGE LambdaCase               #-}
 {-# LANGUAGE NamedFieldPuns           #-}
@@ -166,15 +167,12 @@ gotDhtPubkey pubkey tx theirKey = do
       scheduleSearch (txAnnouncer tx) akey meth pubkey
     tox :: Tox JabberClients
     tox = txTox tx
-    byKey :: TVar (Map.Map PublicKey [Tox.NetCryptoSession])
-    byKey = Tox.netCryptoSessionsByKey $ toxCryptoSessions tox
-    chillSesh :: STM (Maybe (Status Tox.ToxProgress))
-    chillSesh = do
-        x <- (fmap.fmap) Tox.ncState . Map.lookup theirKey <$> readTVar byKey
-        y <- (traverse.traverse) readTVar x
-        return $ join $ listToMaybe <$> y
-    activeSesh :: STM Bool
-    activeSesh = chillSesh >>= return . \case
+    byAddr :: TVar (Map.Map SockAddr Tox.NetCryptoSession)
+    byAddr = Tox.netCryptoSessions (toxCryptoSessions tox)
+    chillSesh :: SockAddr -> STM (Maybe (Status Tox.ToxProgress))
+    chillSesh addr = traverse readTVar =<< fmap Tox.ncState . Map.lookup addr <$> readTVar byAddr
+    activeSesh :: SockAddr -> STM Bool
+    activeSesh a = chillSesh a >>= return . \case
       Just Established -> True
       _                -> False
     target = key2id $ dhtpk pubkey
@@ -200,11 +198,11 @@ gotDhtPubkey pubkey tx theirKey = do
       tput XNodeinfoSearch $ show ("rumor", akey, time, addr, ni)
 
     observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM ()
-    observe akey time ni = do
-      tput XNodeinfoSearch $ show ("observation", akey, time, ni)
+    observe akey time (nodeAddr -> addr) = do
+      tput XNodeinfoSearch $ show ("observation", akey, time, addr)
       scheduleImmediately (txAnnouncer tx) akey $
-        ScheduledItem $ shakeHands activeSesh (getContact theirKey (txAccount tx))
-      setContactAddr time theirKey (nodeAddr ni) (txAccount tx)
+        ScheduledItem $ shakeHands (activeSesh addr) (getContact theirKey (txAccount tx))
+      setContactAddr time theirKey addr (txAccount tx)
 
 shakeHands :: STM Bool -> STM (Maybe Contact) -> Announcer -> AnnounceKey -> POSIXTime -> STM (IO ())
 shakeHands isActive getC ann akey now = do
@@ -214,7 +212,7 @@ shakeHands isActive getC ann akey now = do
     Just contact -> do
       active <- isActive
       if (not active) then do
-        scheduleAbs ann akey (ScheduledItem $ shakeHands isActive getC) (now + 5)
+        scheduleRel ann akey (ScheduledItem $ shakeHands isActive getC) 5
         return $ shakeHandsIO contact
       else
         return $ return ()