From d5f502c05c25ea2c4cba712df340bb9f25dacf8c Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Sat, 20 Jun 2020 22:28:01 +0200
Subject: [PATCH] ping potential neighbours before adding to list

for #44
---
 src/Hash2Pub/FediChord.hs | 22 +++++++++++++++++++---
 1 file changed, 19 insertions(+), 3 deletions(-)

diff --git a/src/Hash2Pub/FediChord.hs b/src/Hash2Pub/FediChord.hs
index 9767aa2..e1ec96b 100644
--- a/src/Hash2Pub/FediChord.hs
+++ b/src/Hash2Pub/FediChord.hs
@@ -61,12 +61,13 @@ import           Crypto.Hash
 import qualified Data.ByteArray                as BA
 import qualified Data.ByteString               as BS
 import qualified Data.ByteString.UTF8          as BSU
+import           Data.Either                   (rights)
 import           Data.Foldable                 (foldr')
 import           Data.IP                       (IPv6, fromHostAddress6,
                                                 toHostAddress6)
 import qualified Data.Map.Strict               as Map
-import           Data.Maybe                    (fromJust, fromMaybe, isJust,
-                                                mapMaybe)
+import           Data.Maybe                    (catMaybes, fromJust, fromMaybe,
+                                                isJust, mapMaybe)
 import qualified Data.Set                      as Set
 import           Data.Time.Clock.POSIX
 import           Data.Typeable                 (Typeable (..), typeOf)
@@ -212,10 +213,25 @@ stabiliseThread nsSTM = forever $ do
                            -> m ()
     parseNeighbourResponse (Left err) = throwError err
     parseNeighbourResponse (Right (succs, preds)) = liftIO $ do
+        -- ping each returned node before actually inserting them
+        -- send pings in parallel, check whether ID is part of the returned IDs
+        nsSnap <- readTVarIO nsSTM
+        pingThreads <- mapM (async . checkReachability nsSnap) $ preds <> succs
+        -- ToDo: exception handling, maybe log them
+        -- filter out own node
+        checkedNeighbours <- filter (/= toRemoteNodeState nsSnap) . catMaybes . rights <$> mapM waitCatch pingThreads
+
         atomically $ do
             newerNsSnap <- readTVar nsSTM
-            writeTVar nsSTM $ addPredecessors preds . addSuccessors succs $ newerNsSnap
+            writeTVar nsSTM $ addPredecessors checkedNeighbours . addSuccessors checkedNeighbours $ newerNsSnap
         pure ()
+    checkReachability :: LocalNodeState -> RemoteNodeState -> IO (Maybe RemoteNodeState)
+    checkReachability ns toCheck = do
+        resp <- requestPing ns toCheck
+        pure $ either (const Nothing) (\vss ->
+            if toCheck `elem` vss then Just toCheck else Nothing
+                       ) resp
+
 
 -- periodically contact immediate successor and predecessor
 -- If they respond, see whether there is a closer neighbour in between