schmittlauch/Hash2Pub
1
0
Fork 1
Code Issues 47 Pull requests Releases Wiki Activity

forgot handling the successors and predecessors of the leaving node

Browse source 
contributes to #28
This commit is contained in:
Trolli Schmittlauch 2020-06-07 00:21:03 +02:00
parent e00da9b84f
commit 0a9b0547c6
1 changed files with 13 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

20
src/Hash2Pub/DHTProtocol.hs
View file

@ -38,7 +38,7 @@ import Data.Foldable (foldl', foldr')
import Data.Functor.Identity import Data.Functor.Identity
import Data.IP (IPv6, fromHostAddress6, import Data.IP (IPv6, fromHostAddress6,
toHostAddress6) toHostAddress6)
import Data.List (delete, sortBy) import Data.List (delete, nub, sortBy)
import qualified Data.Map as Map import qualified Data.Map as Map
import Data.Maybe (fromJust, fromMaybe, mapMaybe, import Data.Maybe (fromJust, fromMaybe, mapMaybe,
maybe) maybe)
@ -214,16 +214,22 @@ handleIncomingRequest nsSTM sendQ msgSet sourceAddr = do
-- TODO: copy over key data from leaver and confirm -- TODO: copy over key data from leaver and confirm
respondLeave :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString) respondLeave :: LocalNodeStateSTM -> Set.Set FediChordMessage -> IO (Map.Map Integer BS.ByteString)
respondLeave nsSTM msgSet = do 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 responseMsg <- atomically $ do
nsSnap <- readTVar nsSTM nsSnap <- readTVar nsSTM
let
aRequestPart = Set.elemAt 0 msgSet
senderID = getNid . sender $ aRequestPart
-- remove leaving node from successors, predecessors and NodeCache -- remove leaving node from successors, predecessors and NodeCache
writeTQueue (cacheWriteQueue nsSnap) $ deleteCacheEntry senderID writeTQueue (cacheWriteQueue nsSnap) $ deleteCacheEntry senderID
writeTVar nsSTM $ writeTVar nsSTM $
setPredecessors (delete senderID $ predecessors nsSnap) -- add predecessors and successors of leaving node to own lists
. setSuccessors (delete senderID $ successors nsSnap) $ nsSnap 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 -- TODO: handle handover of key data
let leaveResponse = Response { let leaveResponse = Response {
responseTo = requestID aRequestPart responseTo = requestID aRequestPart
@ -295,7 +301,7 @@ respondJoin nsSTM msgSet = do
then do then do
-- if yes, adjust own predecessors/ successors and return those in a response -- if yes, adjust own predecessors/ successors and return those in a response
let 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 joinedNS = setPredecessors newPreds nsSnap
responsePayload = JoinResponsePayload { responsePayload = JoinResponsePayload {
joinSuccessors = successors joinedNS joinSuccessors = successors joinedNS