forgot handling the successors and predecessors of the leaving node
contributes to #28
This commit is contained in:
parent
e00da9b84f
commit
0a9b0547c6
|
@ -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
|
||||
|
|
Loading…
Reference in a new issue