stub out the handshake announcer

1 files changed, 29 insertions, 1 deletions

diff --git a/ToxToXMPP.hs b/ToxToXMPP.hs
index 2659f56e..e2cefc9d 100644
--- a/ToxToXMPP.hs
+++ b/ToxToXMPP.hs
@@ -176,6 +176,17 @@ 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
+      Just Established -> True
+      _                -> False
     target = key2id $ dhtpk pubkey
     meth :: SearchMethod Tox.DHTPublicKey
     meth =
@@ -201,9 +212,26 @@ gotDhtPubkey pubkey tx theirKey = do
     observe :: AnnounceKey -> POSIXTime -> NodeInfo -> STM ()
     observe akey time ni = do
       tput XNodeinfoSearch $ show ("observation", akey, time, ni)
-      unschedule (txAnnouncer tx) akey -- todo: schedule the handshake here
+      scheduleImmediately (txAnnouncer tx) akey $
+        ScheduledItem $ shakeHands activeSesh (getContact theirKey (txAccount tx))
       setContactAddr time theirKey (nodeAddr ni) (txAccount tx)
 
+shakeHands :: STM Bool -> STM (Maybe Contact) -> Announcer -> AnnounceKey -> POSIXTime -> STM (IO ())
+shakeHands isActive getC ann akey now = do
+  mbContact <- getC
+  case mbContact of
+    Nothing -> return $ return ()
+    Just contact -> do
+      active <- isActive
+      if (not active) then do
+        scheduleAbs ann akey (ScheduledItem $ shakeHands isActive getC) (now + 5)
+        return $ shakeHandsIO contact
+      else
+        return $ return ()
+
+shakeHandsIO :: Contact -> IO ()
+shakeHandsIO _ = return ()
+
 dispatch :: ToxToXMPP -> ContactEvent -> IO ()
 dispatch tx (SessionEstablished theirKey) = stopConnecting tx theirKey
 dispatch tx (SessionTerminated theirKey)  = startConnecting tx theirKey