From 0a9b0547c67da0840ad3463e04a14794b6464198 Mon Sep 17 00:00:00 2001
From: Trolli Schmittlauch <t.schmittlauch@orlives.de>
Date: Sun, 7 Jun 2020 00:21:03 +0200
Subject: [PATCH] forgot handling the successors and predecessors of the
 leaving node

contributes to #28
---
 src/Hash2Pub/DHTProtocol.hs | 20 +++++++++++++-------
 1 file changed, 13 insertions(+), 7 deletions(-)

diff --git a/src/Hash2Pub/DHTProtocol.hs b/src/Hash2Pub/DHTProtocol.hs
index 5cbba56..313471c 100644
--- a/src/Hash2Pub/DHTProtocol.hs
+++ b/src/Hash2Pub/DHTProtocol.hs
@@ -38,7 +38,7 @@ import           Data.Foldable                  (foldl', foldr')
 import           Data.Functor.Identity
 import           Data.IP                        (IPv6, fromHostAddress6,
                                                  toHostAddress6)
-import           Data.List                      (delete, sortBy)
+import           Data.List                      (delete, nub, sortBy)
 import qualified Data.Map                       as Map
 import           Data.Maybe                     (fromJust, fromMaybe, mapMaybe,
                                                  maybe)
@@ -214,16 +214,22 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do
 -- TODO: copy over key data from leaver and confirm
 respondLeave :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString)
 respondLeave nsSTM msgSet = do
+    -- combine payload of all parts
+    let (requestSuccs, requestPreds) = foldr' (\msg (succAcc, predAcc) ->
+            (maybe succAcc (++ succAcc) (leaveSuccessors <$> payload msg)
+            ,maybe predAcc (++ predAcc) (leavePredecessors <$> payload msg))
+                                              )
+                                              ([],[]) msgSet
+        aRequestPart = Set.elemAt 0 msgSet
+        senderID = getNid . sender $ aRequestPart
     responseMsg <- atomically $ do
         nsSnap <- readTVar nsSTM
-        let
-            aRequestPart = Set.elemAt 0 msgSet
-            senderID = getNid . sender $ aRequestPart
         -- remove leaving node from successors, predecessors and NodeCache
         writeTQueue (cacheWriteQueue nsSnap) $ deleteCacheEntry senderID
         writeTVar nsSTM $
-            setPredecessors (delete senderID $ predecessors nsSnap)
-          . setSuccessors (delete senderID $ successors nsSnap) $ nsSnap
+            -- add predecessors and successors of leaving node to own lists
+            setPredecessors (take (kNeighbours nsSnap) . delete senderID . nub . sortBy (flip localCompare) $ requestPreds <> predecessors nsSnap)
+          . setSuccessors (take (kNeighbours nsSnap) . delete senderID . nub . sortBy localCompare $ requestSuccs <> successors nsSnap) $ nsSnap
         -- TODO: handle handover of key data
         let leaveResponse = Response {
                 responseTo = requestID aRequestPart
@@ -295,7 +301,7 @@ respondJoin nsSTM msgSet = do
         then do
         -- if yes, adjust own predecessors/ successors and return those in a response
            let
-             newPreds = take (kNeighbours nsSnap) . sortBy (flip localCompare) $ getNid senderNS:predecessors nsSnap
+             newPreds = take (kNeighbours nsSnap) . nub . sortBy (flip localCompare) $ getNid senderNS:predecessors nsSnap
              joinedNS = setPredecessors newPreds nsSnap
              responsePayload = JoinResponsePayload {
                 joinSuccessors = successors joinedNS