forgot handling the successors and predecessors of the leaving node

contributes to #28
This commit is contained in:
Trolli Schmittlauch 2020-06-07 00:21:03 +02:00
parent e00da9b84f
commit 0a9b0547c6

View file

@ -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
responseMsg <- atomically $ do
nsSnap <- readTVar nsSTM
let
-- 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
-- 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